moose collection extensions

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
24 messages Options
12
Reply | Threaded
Open this post in threaded view
|

moose collection extensions

Stéphane Ducasse
hi

here are the collection extensions we use in Moose.
I copied them to PharoTaskForces so that we can discuss and tweak the code if wanted.

My favorite is
        flatCollect:/flatCollectAsSet:
        groupedBy:
       
        There are really useful.

Stef


testFlatCollectArray
        "self debug: #testFlatCollectArray"
       
        self assert: ((#((1 2) (3 4) (5 3)) flatCollect: [ :each ]) = #(1 2 3 4 5 3)).
        self assert: ((#((1 2) (2 3) (1 3 4)) flatCollect: [:each]) = #(1 2 2 3 1 3 4)).
               
        self assert: ((#((1 2) (2 3) () ()) flatCollect: [:each]) = #(1 2 2 3)).

        self assert: ((#((1 2) (2 3) (1 3 4)) flatCollect: [:each| Array with: each])
                                        =  #(#(1 2) #(2 3) #(1 3 4))).
                                       
        self assert: ((#((1 2) (2 3) (1 3 4)) flatCollect: [:each| Set with: each])
                                        =  #(#(1 2) #(2 3) #(1 3 4))).
       

testFlatCollectSet
        "self debug: #testFlatCollectSet"
       
        self assert: ((#((1 2) (1 2) (1 3 4)) asSet  flatCollect: [:each]) = #(1 1 2 3 4) asSet).
        self assert: ((#() asSet flatCollect: [:each]) = #() asSet).

        self assert:  ((#((1 2) () (1 3 4)) asSet  flatCollect: [:each]) = #(1 1 2 3 4) asSet).
        self assert:  ((#((1 2) #((99)) (1 3 4)) asSet  flatCollect: [:each])
                                        = #(1 1 2 3 4 (99)) asSet).
        self assert:  ((#((1 2) #(()) (1 3 4)) asSet  flatCollect: [:each])
                                        = #(1 1 2 3 4 ()) asSet).

testCollectAsSet
        "self debug: #testCollectAsSet"
       
        self assert: ((#() collectAsSet: [:each | each odd]) = Set new).
        self assert: (#(1 2 3 4 5 6) collectAsSet: [:each | each odd])
                                         = (Set with: true with: false).
        self assert: (#(1 3 5 7 9 11) collectAsSet: [:each | each odd])
                                        = (Set with: true).
                                       
        self assert: (#(1 2 3 4 5 4 3 2 1) collectAsSet: [:each | each]) = (1 to: 5) asSet.
       
       
testGroupedByArray
        "self debug: #testGroupedByArray"
       
        | res |
        res := #(1 2 3 4 5) groupedBy: [:each | each odd].
        self assert:   (res at: true) = #(1 3 5).
        self assert: (res at: false) = #(2 4)



Set>>flatCollect: aBlock
       
       
        ^self flatCollectAsSet: aBlock


Symbol>>value
        "Allow this object to act as a ValueHolder on itself."

        ^self

OrderedCollection>>removeAtIndex: anIndex
        "Remove the element of the collection at position anIndex.  Answer the object removed."

        | obj |
        obj := self at: anIndex.
        self removeIndex: anIndex + firstIndex - 1.
        ^obj

Collection
==============================

collectAsSet: aBlock
        "Evaluates aBlock for each element of the receiver and collects
        the resulting values into a Set."

        "This is an efficient shorthand for [ (self collect: aBlock) asSet ]."
        "originally developed by a. kuhn and released under MIT."
       
        ^self inject: Set new into: [ :set :each |
                set add: (aBlock value: each); yourself ].


copyEmpty: aSize
        "Answer a copy of the receiver that contains no elements.

        This method should be redefined in subclasses that add
        instance variables, so that the state of those variables
        is preserved"

        ^self class new: aSize


flatCollect: aBlock
        "Evaluate aBlock for each of the receiver's elements and answer the
        list of all resulting values flatten one level. Assumes that aBlock returns some kind
        of collection for each element. Equivalent to the lisp's mapcan"
        "original written by a. Kuhn and released under MIT"
       
        | stream |
        self isEmpty ifTrue: [ ^ self copy ].
        stream := (self species new: 0) nsWriteStream.
        self do: [ :each | stream nextPutAll: (aBlock value: each) ].
        ^ stream contents

flatCollectAsSet: aBlock
        "Evaluate aBlock for each of the receiver's elements and answer the
        list of all resulting values flatten one level. Assumes that aBlock returns some kind
        of collection for each element. Equivalent to the lisp's mapcan"
       
        "original written by a. Kuhn and released under MIT"
       
        | set |
        self isEmpty ifTrue: [^self copy ].
        set := Set new.
        self do: [ :each |
                set addAll: (aBlock value: each) ].
        ^set


flatten
        "Recursively collect each non-collection element of the receiver and its descendant
        collections.  Please note, this implementation assumes that strings are to be treated
        as objects rather than as collection."

        ^self gather: [ :each ]

groupedBy: aBlock
        "Return a dictionary whose keys are the result of evaluating aBlock for all elements in
         the collection, and the value for each key is the collection of elements that evaluated
         to that key. e.g.
             #(1 2 3 4 5) groupedBy: [:each | each odd]
           a Dictionary  
             true ---> #( 1 3 5)
             false --> #(2 4)
        originally developed by a. kuhn and released under MIT."

        | result |
        result := Dictionary new.
        self do:
                [:each | | key collection |
                key := aBlock value: each.
                collection := result at: key ifAbsentPut: [OrderedCollection new].
                collection add: each].
        self species ~~ OrderedCollection ifTrue:
                ["Convert the result collections to be the right type.
                  Note that it should be safe to modify the dictionary
                  while iterating because we only replace values for existing keys"
                result keysAndValuesDo:
                        [:key :value | result at: key put: (self species withAll: value)]].

        ^result

includesAll: aCollection
        "Answer true if the receiver includes all elements of aCollection with at
        least as many occurrences as in aCollection. For a less strict comparison
        please refer to supersetOf: and its inverse subsetOf:."


        ^(aCollection isCollection) and: [
                aCollection size <= self size and: [
                        aCollection allSatisfy: [ :each |
                                (aCollection occurrencesOf: each) <= (self occurrencesOf: each) ]]]

nilSafeGroupedBy: aBlock
        ^ self groupedBy: [ :each |
                | value |
                value := aBlock value: each.
                value ifNil: [ UndefinedObject ].
        ]

selectAsSet: aBlock
        "Evaluate aBlock with each of the receiver's elements as the argument.
        Collect into a new set, only those elements for which
        aBlock evaluates to true.  Answer the new collection."

        | newSet |
        newSet := Set new.
        self do: [:each | (aBlock value: each) ifTrue: [newSet add: each]].
        ^newSet

shuffle
        "Swaps the receiver's elements at random."

        self shuffle: (self size * self size log) asInteger

sum: aSymbolOrBlock
         
        ^self
                inject: 0
                into: [:sum :each | sum + (aSymbolOrBlock value: each)]

shuffle: times
        "Swaps random elements of the receiver."

        | size random |
        size := self size.
        random := Random new.
        times timesRepeat: [
                self swap: (random next * size) floor + 1 with: (random next * size) floor + 1
        ].




_______________________________________________
Pharo-project mailing list
[hidden email]
http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project
Reply | Threaded
Open this post in threaded view
|

Re: moose collection extensions

Lukas Renggli
Iiik, that uses

    [ :each ] = [ :each | each ]

everywhere.

Lukas

2009/12/27 Stéphane Ducasse <[hidden email]>:

> hi
>
> here are the collection extensions we use in Moose.
> I copied them to PharoTaskForces so that we can discuss and tweak the code if wanted.
>
> My favorite is
>        flatCollect:/flatCollectAsSet:
>        groupedBy:
>
>        There are really useful.
>
> Stef
>
>
> testFlatCollectArray
>        "self debug: #testFlatCollectArray"
>
>        self assert: ((#((1 2) (3 4) (5 3)) flatCollect: [ :each ]) = #(1 2 3 4 5 3)).
>        self assert: ((#((1 2) (2 3) (1 3 4)) flatCollect: [:each]) = #(1 2 2 3 1 3 4)).
>
>        self assert: ((#((1 2) (2 3) () ()) flatCollect: [:each]) = #(1 2 2 3)).
>
>        self assert: ((#((1 2) (2 3) (1 3 4)) flatCollect: [:each| Array with: each])
>                                        =  #(#(1 2) #(2 3) #(1 3 4))).
>
>        self assert: ((#((1 2) (2 3) (1 3 4)) flatCollect: [:each| Set with: each])
>                                        =  #(#(1 2) #(2 3) #(1 3 4))).
>
>
> testFlatCollectSet
>        "self debug: #testFlatCollectSet"
>
>        self assert: ((#((1 2) (1 2) (1 3 4)) asSet  flatCollect: [:each]) = #(1 1 2 3 4) asSet).
>        self assert: ((#() asSet flatCollect: [:each]) = #() asSet).
>
>        self assert:  ((#((1 2) () (1 3 4)) asSet  flatCollect: [:each]) = #(1 1 2 3 4) asSet).
>        self assert:  ((#((1 2) #((99)) (1 3 4)) asSet  flatCollect: [:each])
>                                        = #(1 1 2 3 4 (99)) asSet).
>        self assert:  ((#((1 2) #(()) (1 3 4)) asSet  flatCollect: [:each])
>                                        = #(1 1 2 3 4 ()) asSet).
>
> testCollectAsSet
>        "self debug: #testCollectAsSet"
>
>        self assert: ((#() collectAsSet: [:each | each odd]) = Set new).
>        self assert: (#(1 2 3 4 5 6) collectAsSet: [:each | each odd])
>                                         = (Set with: true with: false).
>        self assert: (#(1 3 5 7 9 11) collectAsSet: [:each | each odd])
>                                        = (Set with: true).
>
>        self assert: (#(1 2 3 4 5 4 3 2 1) collectAsSet: [:each | each]) = (1 to: 5) asSet.
>
>
> testGroupedByArray
>        "self debug: #testGroupedByArray"
>
>        | res |
>        res := #(1 2 3 4 5) groupedBy: [:each | each odd].
>        self assert:   (res at: true) = #(1 3 5).
>        self assert: (res at: false) = #(2 4)
>
>
>
> Set>>flatCollect: aBlock
>
>
>        ^self flatCollectAsSet: aBlock
>
>
> Symbol>>value
>        "Allow this object to act as a ValueHolder on itself."
>
>        ^self
>
> OrderedCollection>>removeAtIndex: anIndex
>        "Remove the element of the collection at position anIndex.  Answer the object removed."
>
>        | obj |
>        obj := self at: anIndex.
>        self removeIndex: anIndex + firstIndex - 1.
>        ^obj
>
> Collection
> ==============================
>
> collectAsSet: aBlock
>        "Evaluates aBlock for each element of the receiver and collects
>        the resulting values into a Set."
>
>        "This is an efficient shorthand for [ (self collect: aBlock) asSet ]."
>        "originally developed by a. kuhn and released under MIT."
>
>        ^self inject: Set new into: [ :set :each |
>                set add: (aBlock value: each); yourself ].
>
>
> copyEmpty: aSize
>        "Answer a copy of the receiver that contains no elements.
>
>        This method should be redefined in subclasses that add
>        instance variables, so that the state of those variables
>        is preserved"
>
>        ^self class new: aSize
>
>
> flatCollect: aBlock
>        "Evaluate aBlock for each of the receiver's elements and answer the
>        list of all resulting values flatten one level. Assumes that aBlock returns some kind
>        of collection for each element. Equivalent to the lisp's mapcan"
>        "original written by a. Kuhn and released under MIT"
>
>        | stream |
>        self isEmpty ifTrue: [ ^ self copy ].
>        stream := (self species new: 0) nsWriteStream.
>        self do: [ :each | stream nextPutAll: (aBlock value: each) ].
>        ^ stream contents
>
> flatCollectAsSet: aBlock
>        "Evaluate aBlock for each of the receiver's elements and answer the
>        list of all resulting values flatten one level. Assumes that aBlock returns some kind
>        of collection for each element. Equivalent to the lisp's mapcan"
>
>        "original written by a. Kuhn and released under MIT"
>
>        | set |
>        self isEmpty ifTrue: [^self copy ].
>        set := Set new.
>        self do: [ :each |
>                set addAll: (aBlock value: each) ].
>        ^set
>
>
> flatten
>        "Recursively collect each non-collection element of the receiver and its descendant
>        collections.  Please note, this implementation assumes that strings are to be treated
>        as objects rather than as collection."
>
>        ^self gather: [ :each ]
>
> groupedBy: aBlock
>        "Return a dictionary whose keys are the result of evaluating aBlock for all elements in
>         the collection, and the value for each key is the collection of elements that evaluated
>         to that key. e.g.
>             #(1 2 3 4 5) groupedBy: [:each | each odd]
>           a Dictionary
>             true ---> #( 1 3 5)
>             false --> #(2 4)
>        originally developed by a. kuhn and released under MIT."
>
>        | result |
>        result := Dictionary new.
>        self do:
>                [:each | | key collection |
>                key := aBlock value: each.
>                collection := result at: key ifAbsentPut: [OrderedCollection new].
>                collection add: each].
>        self species ~~ OrderedCollection ifTrue:
>                ["Convert the result collections to be the right type.
>                  Note that it should be safe to modify the dictionary
>                  while iterating because we only replace values for existing keys"
>                result keysAndValuesDo:
>                        [:key :value | result at: key put: (self species withAll: value)]].
>
>        ^result
>
> includesAll: aCollection
>        "Answer true if the receiver includes all elements of aCollection with at
>        least as many occurrences as in aCollection. For a less strict comparison
>        please refer to supersetOf: and its inverse subsetOf:."
>
>
>        ^(aCollection isCollection) and: [
>                aCollection size <= self size and: [
>                        aCollection allSatisfy: [ :each |
>                                (aCollection occurrencesOf: each) <= (self occurrencesOf: each) ]]]
>
> nilSafeGroupedBy: aBlock
>        ^ self groupedBy: [ :each |
>                | value |
>                value := aBlock value: each.
>                value ifNil: [ UndefinedObject ].
>        ]
>
> selectAsSet: aBlock
>        "Evaluate aBlock with each of the receiver's elements as the argument.
>        Collect into a new set, only those elements for which
>        aBlock evaluates to true.  Answer the new collection."
>
>        | newSet |
>        newSet := Set new.
>        self do: [:each | (aBlock value: each) ifTrue: [newSet add: each]].
>        ^newSet
>
> shuffle
>        "Swaps the receiver's elements at random."
>
>        self shuffle: (self size * self size log) asInteger
>
> sum: aSymbolOrBlock
>
>        ^self
>                inject: 0
>                into: [:sum :each | sum + (aSymbolOrBlock value: each)]
>
> shuffle: times
>        "Swaps random elements of the receiver."
>
>        | size random |
>        size := self size.
>        random := Random new.
>        times timesRepeat: [
>                self swap: (random next * size) floor + 1 with: (random next * size) floor + 1
>        ].
>
>
>
>
> _______________________________________________
> Pharo-project mailing list
> [hidden email]
> http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project
>



--
Lukas Renggli
http://www.lukas-renggli.ch

_______________________________________________
Pharo-project mailing list
[hidden email]
http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project
Reply | Threaded
Open this post in threaded view
|

Re: moose collection extensions

Stéphane Ducasse
take a deep breath :)
lol
This is for tests :)
In moose we will up with ugly expression ;D

Stef

On Dec 27, 2009, at 5:29 PM, Lukas Renggli wrote:

> Iiik, that uses
>
>    [ :each ] = [ :each | each ]
>
> everywhere.
>
> Lukas
>
> 2009/12/27 Stéphane Ducasse <[hidden email]>:
>> hi
>>
>> here are the collection extensions we use in Moose.
>> I copied them to PharoTaskForces so that we can discuss and tweak the code if wanted.
>>
>> My favorite is
>>        flatCollect:/flatCollectAsSet:
>>        groupedBy:
>>
>>        There are really useful.
>>
>> Stef
>>
>>
>> testFlatCollectArray
>>        "self debug: #testFlatCollectArray"
>>
>>        self assert: ((#((1 2) (3 4) (5 3)) flatCollect: [ :each ]) = #(1 2 3 4 5 3)).
>>        self assert: ((#((1 2) (2 3) (1 3 4)) flatCollect: [:each]) = #(1 2 2 3 1 3 4)).
>>
>>        self assert: ((#((1 2) (2 3) () ()) flatCollect: [:each]) = #(1 2 2 3)).
>>
>>        self assert: ((#((1 2) (2 3) (1 3 4)) flatCollect: [:each| Array with: each])
>>                                        =  #(#(1 2) #(2 3) #(1 3 4))).
>>
>>        self assert: ((#((1 2) (2 3) (1 3 4)) flatCollect: [:each| Set with: each])
>>                                        =  #(#(1 2) #(2 3) #(1 3 4))).
>>
>>
>> testFlatCollectSet
>>        "self debug: #testFlatCollectSet"
>>
>>        self assert: ((#((1 2) (1 2) (1 3 4)) asSet  flatCollect: [:each]) = #(1 1 2 3 4) asSet).
>>        self assert: ((#() asSet flatCollect: [:each]) = #() asSet).
>>
>>        self assert:  ((#((1 2) () (1 3 4)) asSet  flatCollect: [:each]) = #(1 1 2 3 4) asSet).
>>        self assert:  ((#((1 2) #((99)) (1 3 4)) asSet  flatCollect: [:each])
>>                                        = #(1 1 2 3 4 (99)) asSet).
>>        self assert:  ((#((1 2) #(()) (1 3 4)) asSet  flatCollect: [:each])
>>                                        = #(1 1 2 3 4 ()) asSet).
>>
>> testCollectAsSet
>>        "self debug: #testCollectAsSet"
>>
>>        self assert: ((#() collectAsSet: [:each | each odd]) = Set new).
>>        self assert: (#(1 2 3 4 5 6) collectAsSet: [:each | each odd])
>>                                         = (Set with: true with: false).
>>        self assert: (#(1 3 5 7 9 11) collectAsSet: [:each | each odd])
>>                                        = (Set with: true).
>>
>>        self assert: (#(1 2 3 4 5 4 3 2 1) collectAsSet: [:each | each]) = (1 to: 5) asSet.
>>
>>
>> testGroupedByArray
>>        "self debug: #testGroupedByArray"
>>
>>        | res |
>>        res := #(1 2 3 4 5) groupedBy: [:each | each odd].
>>        self assert:   (res at: true) = #(1 3 5).
>>        self assert: (res at: false) = #(2 4)
>>
>>
>>
>> Set>>flatCollect: aBlock
>>
>>
>>        ^self flatCollectAsSet: aBlock
>>
>>
>> Symbol>>value
>>        "Allow this object to act as a ValueHolder on itself."
>>
>>        ^self
>>
>> OrderedCollection>>removeAtIndex: anIndex
>>        "Remove the element of the collection at position anIndex.  Answer the object removed."
>>
>>        | obj |
>>        obj := self at: anIndex.
>>        self removeIndex: anIndex + firstIndex - 1.
>>        ^obj
>>
>> Collection
>> ==============================
>>
>> collectAsSet: aBlock
>>        "Evaluates aBlock for each element of the receiver and collects
>>        the resulting values into a Set."
>>
>>        "This is an efficient shorthand for [ (self collect: aBlock) asSet ]."
>>        "originally developed by a. kuhn and released under MIT."
>>
>>        ^self inject: Set new into: [ :set :each |
>>                set add: (aBlock value: each); yourself ].
>>
>>
>> copyEmpty: aSize
>>        "Answer a copy of the receiver that contains no elements.
>>
>>        This method should be redefined in subclasses that add
>>        instance variables, so that the state of those variables
>>        is preserved"
>>
>>        ^self class new: aSize
>>
>>
>> flatCollect: aBlock
>>        "Evaluate aBlock for each of the receiver's elements and answer the
>>        list of all resulting values flatten one level. Assumes that aBlock returns some kind
>>        of collection for each element. Equivalent to the lisp's mapcan"
>>        "original written by a. Kuhn and released under MIT"
>>
>>        | stream |
>>        self isEmpty ifTrue: [ ^ self copy ].
>>        stream := (self species new: 0) nsWriteStream.
>>        self do: [ :each | stream nextPutAll: (aBlock value: each) ].
>>        ^ stream contents
>>
>> flatCollectAsSet: aBlock
>>        "Evaluate aBlock for each of the receiver's elements and answer the
>>        list of all resulting values flatten one level. Assumes that aBlock returns some kind
>>        of collection for each element. Equivalent to the lisp's mapcan"
>>
>>        "original written by a. Kuhn and released under MIT"
>>
>>        | set |
>>        self isEmpty ifTrue: [^self copy ].
>>        set := Set new.
>>        self do: [ :each |
>>                set addAll: (aBlock value: each) ].
>>        ^set
>>
>>
>> flatten
>>        "Recursively collect each non-collection element of the receiver and its descendant
>>        collections.  Please note, this implementation assumes that strings are to be treated
>>        as objects rather than as collection."
>>
>>        ^self gather: [ :each ]
>>
>> groupedBy: aBlock
>>        "Return a dictionary whose keys are the result of evaluating aBlock for all elements in
>>         the collection, and the value for each key is the collection of elements that evaluated
>>         to that key. e.g.
>>             #(1 2 3 4 5) groupedBy: [:each | each odd]
>>           a Dictionary
>>             true ---> #( 1 3 5)
>>             false --> #(2 4)
>>        originally developed by a. kuhn and released under MIT."
>>
>>        | result |
>>        result := Dictionary new.
>>        self do:
>>                [:each | | key collection |
>>                key := aBlock value: each.
>>                collection := result at: key ifAbsentPut: [OrderedCollection new].
>>                collection add: each].
>>        self species ~~ OrderedCollection ifTrue:
>>                ["Convert the result collections to be the right type.
>>                  Note that it should be safe to modify the dictionary
>>                  while iterating because we only replace values for existing keys"
>>                result keysAndValuesDo:
>>                        [:key :value | result at: key put: (self species withAll: value)]].
>>
>>        ^result
>>
>> includesAll: aCollection
>>        "Answer true if the receiver includes all elements of aCollection with at
>>        least as many occurrences as in aCollection. For a less strict comparison
>>        please refer to supersetOf: and its inverse subsetOf:."
>>
>>
>>        ^(aCollection isCollection) and: [
>>                aCollection size <= self size and: [
>>                        aCollection allSatisfy: [ :each |
>>                                (aCollection occurrencesOf: each) <= (self occurrencesOf: each) ]]]
>>
>> nilSafeGroupedBy: aBlock
>>        ^ self groupedBy: [ :each |
>>                | value |
>>                value := aBlock value: each.
>>                value ifNil: [ UndefinedObject ].
>>        ]
>>
>> selectAsSet: aBlock
>>        "Evaluate aBlock with each of the receiver's elements as the argument.
>>        Collect into a new set, only those elements for which
>>        aBlock evaluates to true.  Answer the new collection."
>>
>>        | newSet |
>>        newSet := Set new.
>>        self do: [:each | (aBlock value: each) ifTrue: [newSet add: each]].
>>        ^newSet
>>
>> shuffle
>>        "Swaps the receiver's elements at random."
>>
>>        self shuffle: (self size * self size log) asInteger
>>
>> sum: aSymbolOrBlock
>>
>>        ^self
>>                inject: 0
>>                into: [:sum :each | sum + (aSymbolOrBlock value: each)]
>>
>> shuffle: times
>>        "Swaps random elements of the receiver."
>>
>>        | size random |
>>        size := self size.
>>        random := Random new.
>>        times timesRepeat: [
>>                self swap: (random next * size) floor + 1 with: (random next * size) floor + 1
>>        ].
>>
>>
>>
>>
>> _______________________________________________
>> Pharo-project mailing list
>> [hidden email]
>> http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project
>>
>
>
>
> --
> Lukas Renggli
> http://www.lukas-renggli.ch
>
> _______________________________________________
> Pharo-project mailing list
> [hidden email]
> http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project


_______________________________________________
Pharo-project mailing list
[hidden email]
http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project
Reply | Threaded
Open this post in threaded view
|

Re: moose collection extensions

csrabak
In reply to this post by Stéphane Ducasse
I find a lot of them awesome.  However I would like to point out that in order these additions to make a difference they'll need to be spread the information as early as we can, so even in PBE we need to have a corner to address these "extensions/additions", otherwise they'll become curiosity for a lot of Pharoers. . .

my 0.0199999...

--
Cesar Rabak


Em 27/12/2009 14:26, Stéphane Ducasse < [hidden email] > escreveu:


hi

here are the collection extensions we use in Moose.
I copied them to PharoTaskForces so that we can discuss and tweak the code if wanted.

My favorite is
 flatCollect:/flatCollectAsSet:
 groupedBy:
 
 There are really useful.

Stef

[snipped]

_______________________________________________
Pharo-project mailing list
[hidden email]
http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project
Reply | Threaded
Open this post in threaded view
|

Re: moose collection extensions

Adrian Kuhn
In reply to this post by Stéphane Ducasse
Stéphane Ducasse <stephane.ducasse@...> writes:

> here are the collection extensions we use in Moose. I copied them to
> PharoTaskForces so that we can discuss and tweak the code if wanted.

Just missed #collectAsSet: and #groupedBy: yesterday :) Given that I have
 written all of these extensions (except #copyEmpty: and #groupedBy: which are
 provided by VW as far I recall) I am of course baised, but also pleased to
 see them being used and possibly included in Pharo.

There is also a #trasitiveClosure: extensions, which was ported by Oscar
 already, see http://www.squeaksource.com/CodePhoo but with different
 semantics than in the original Codefoo.

An (incomplete) documentation of Codefoo can be found here
 http://scg.unibe.ch/staff/adriankuhn/codefoo

NB: #shuffle: does not produce all permutations with the same likelihood! It
 should be changed. I can provide the correct implementation. Also then,
 #shuffle: times should be removed. That is nonsense, a broken shuffle does
 no get better the longer you shuffle :)

cheers,
AA


_______________________________________________
Pharo-project mailing list
[hidden email]
http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project
Reply | Threaded
Open this post in threaded view
|

Re: moose collection extensions

Adrian Kuhn
Adrian Kuhn <akuhn@...> writes:

> NB: #shuffle: does not produce all permutations with the same likelihood! It
>  should be changed. I can provide the correct implementation. Also then,
>  #shuffle: times should be removed. That is nonsense, a broken shuffle does
>  no get better the longer you shuffle :)

Fix uploaded.

cheers,
AA


--
2nd Workshop on Software Search et cetera...
Submit papers by January 19, 2010. http://bit.ly/suite2010


_______________________________________________
Pharo-project mailing list
[hidden email]
http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project
Reply | Threaded
Open this post in threaded view
|

Re: moose collection extensions

Stéphane Ducasse
In reply to this post by Adrian Kuhn
Adrian I imagine that we clarified some of the flatCollectAsSet:..
I do not remember but we moved method names around because they were not fitting well.
Now for shuffle I do not know if we used them and I would remove it.

Stef

On Dec 27, 2009, at 7:56 PM, Adrian Kuhn wrote:

> Stéphane Ducasse <stephane.ducasse@...> writes:
>
>> here are the collection extensions we use in Moose. I copied them to
>> PharoTaskForces so that we can discuss and tweak the code if wanted.
>
> Just missed #collectAsSet: and #groupedBy: yesterday :) Given that I have
> written all of these extensions (except #copyEmpty: and #groupedBy: which are
> provided by VW as far I recall) I am of course baised, but also pleased to
> see them being used and possibly included in Pharo.
>
> There is also a #trasitiveClosure: extensions, which was ported by Oscar
> already, see http://www.squeaksource.com/CodePhoo but with different
> semantics than in the original Codefoo.
>
> An (incomplete) documentation of Codefoo can be found here
> http://scg.unibe.ch/staff/adriankuhn/codefoo
>
> NB: #shuffle: does not produce all permutations with the same likelihood! It
> should be changed. I can provide the correct implementation. Also then,
> #shuffle: times should be removed. That is nonsense, a broken shuffle does
> no get better the longer you shuffle :)
>
> cheers,
> AA
>
>
> _______________________________________________
> Pharo-project mailing list
> [hidden email]
> http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project


_______________________________________________
Pharo-project mailing list
[hidden email]
http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project
Reply | Threaded
Open this post in threaded view
|

Re: moose collection extensions

Stéphane Ducasse
In reply to this post by Adrian Kuhn
Where in the PharoTaskForces.
Thanks.

Stef

On Dec 27, 2009, at 8:29 PM, Adrian Kuhn wrote:

> Adrian Kuhn <akuhn@...> writes:
>
>> NB: #shuffle: does not produce all permutations with the same likelihood! It
>> should be changed. I can provide the correct implementation. Also then,
>> #shuffle: times should be removed. That is nonsense, a broken shuffle does
>> no get better the longer you shuffle :)
>
> Fix uploaded.
>
> cheers,
> AA
>
>
> --
> 2nd Workshop on Software Search et cetera...
> Submit papers by January 19, 2010. http://bit.ly/suite2010
>
>
> _______________________________________________
> Pharo-project mailing list
> [hidden email]
> http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project


_______________________________________________
Pharo-project mailing list
[hidden email]
http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project
Reply | Threaded
Open this post in threaded view
|

Re: moose collection extensions

Nicolas Cellier
In reply to this post by Stéphane Ducasse
2009/12/27 Stéphane Ducasse <[hidden email]>:
> Adrian I imagine that we clarified some of the flatCollectAsSet:..
> I do not remember but we moved method names around because they were not fitting well.
> Now for shuffle I do not know if we used them and I would remove it.
>
> Stef
>

flatCollectAsSet: ?
I wonder if you should not rather provide a flatCollect:as: like
Levente did to the simple collect:

Nicolas

> On Dec 27, 2009, at 7:56 PM, Adrian Kuhn wrote:
>
>> Stéphane Ducasse <stephane.ducasse@...> writes:
>>
>>> here are the collection extensions we use in Moose. I copied them to
>>> PharoTaskForces so that we can discuss and tweak the code if wanted.
>>
>> Just missed #collectAsSet: and #groupedBy: yesterday :) Given that I have
>> written all of these extensions (except #copyEmpty: and #groupedBy: which are
>> provided by VW as far I recall) I am of course baised, but also pleased to
>> see them being used and possibly included in Pharo.
>>
>> There is also a #trasitiveClosure: extensions, which was ported by Oscar
>> already, see http://www.squeaksource.com/CodePhoo but with different
>> semantics than in the original Codefoo.
>>
>> An (incomplete) documentation of Codefoo can be found here
>> http://scg.unibe.ch/staff/adriankuhn/codefoo
>>
>> NB: #shuffle: does not produce all permutations with the same likelihood! It
>> should be changed. I can provide the correct implementation. Also then,
>> #shuffle: times should be removed. That is nonsense, a broken shuffle does
>> no get better the longer you shuffle :)
>>
>> cheers,
>> AA
>>
>>
>> _______________________________________________
>> Pharo-project mailing list
>> [hidden email]
>> http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project
>
>
> _______________________________________________
> Pharo-project mailing list
> [hidden email]
> http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project
>

_______________________________________________
Pharo-project mailing list
[hidden email]
http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project
Reply | Threaded
Open this post in threaded view
|

Re: moose collection extensions

Stéphane Ducasse

On Dec 27, 2009, at 9:32 PM, Nicolas Cellier wrote:

> 2009/12/27 Stéphane Ducasse <[hidden email]>:
>> Adrian I imagine that we clarified some of the flatCollectAsSet:..
>> I do not remember but we moved method names around because they were not fitting well.
>> Now for shuffle I do not know if we used them and I would remove it.
>>
>> Stef
>>
>
> flatCollectAsSet: ?
> I wonder if you should not rather provide a flatCollect:as: like
> Levente did to the simple collect:

Probably.
Adrian K. (you see we put your name in the comments :)).
Adrian I was wondering if we could have another / faster implementation that does not really on stream.
Now I'm too tired to think.

Stef

>
> Nicolas
>
>> On Dec 27, 2009, at 7:56 PM, Adrian Kuhn wrote:
>>
>>> Stéphane Ducasse <stephane.ducasse@...> writes:
>>>
>>>> here are the collection extensions we use in Moose. I copied them to
>>>> PharoTaskForces so that we can discuss and tweak the code if wanted.
>>>
>>> Just missed #collectAsSet: and #groupedBy: yesterday :) Given that I have
>>> written all of these extensions (except #copyEmpty: and #groupedBy: which are
>>> provided by VW as far I recall) I am of course baised, but also pleased to
>>> see them being used and possibly included in Pharo.
>>>
>>> There is also a #trasitiveClosure: extensions, which was ported by Oscar
>>> already, see http://www.squeaksource.com/CodePhoo but with different
>>> semantics than in the original Codefoo.
>>>
>>> An (incomplete) documentation of Codefoo can be found here
>>> http://scg.unibe.ch/staff/adriankuhn/codefoo
>>>
>>> NB: #shuffle: does not produce all permutations with the same likelihood! It
>>> should be changed. I can provide the correct implementation. Also then,
>>> #shuffle: times should be removed. That is nonsense, a broken shuffle does
>>> no get better the longer you shuffle :)
>>>
>>> cheers,
>>> AA
>>>
>>>
>>> _______________________________________________
>>> Pharo-project mailing list
>>> [hidden email]
>>> http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project
>>
>>
>> _______________________________________________
>> Pharo-project mailing list
>> [hidden email]
>> http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project
>>
>
> _______________________________________________
> Pharo-project mailing list
> [hidden email]
> http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project


_______________________________________________
Pharo-project mailing list
[hidden email]
http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project
Reply | Threaded
Open this post in threaded view
|

Re: moose collection extensions

Adrian Kuhn
Stéphane Ducasse <stephane.ducasse@...> writes:

> Adrian K. (you see we put your name in the comments :)).

Humbled :)

> Adrian I was wondering if we could have another / faster
 implementation that does not really on stream.

You can, but you'll have to cover Array as a special case.
 And it probably won't be faster than with a stream (I donnu
 about Nile's implementation of #nextPutAll: though).

--AA


_______________________________________________
Pharo-project mailing list
[hidden email]
http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project
Reply | Threaded
Open this post in threaded view
|

Re: moose collection extensions

Levente Uzonyi-2
In reply to this post by Stéphane Ducasse
On Sun, 27 Dec 2009, Stéphane Ducasse wrote:

> hi
>
> here are the collection extensions we use in Moose.
> I copied them to PharoTaskForces so that we can discuss and tweak the code if wanted.
>

I just checked these and most of them are useless misleading or duplicate,
like:

Collection >>
  #collectAsSet: -> #collect:as: (ok, it's new in pharo)
  #equalsTo:
    misleading name, #containsSameElementsAs: would be better IMO
    #(1 1 2) equalsTo: #(2 1 1) ===> true
  #flatCollect: -> #gather:
  #flatCollectAsSet: -> #gather: + #asSet
  #flatten --
    misleading name, since it doesn't change the object, but returns
    a new array and it's only flattening one level which is what #gather:
    does. Tthere's a proper #flattened implementation in squeak treated
    inbox if you're interested. (guess why it's not in the trunk)
  #groupBy: -> #groupBy:having:
  #sum: -> #detectSum:

Symbol >>
  #value (same as super)

SequenceableCollection >>
  #shuffle -> #shuffled

OrderedCollection >>
  #removeAtIndex: -> #removeAt:

(-> means that the extension on the left is the same as or worse than
  the already existing method(s) on the right)

I guess you should shrink this package. :)


Levente
_______________________________________________
Pharo-project mailing list
[hidden email]
http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project
Reply | Threaded
Open this post in threaded view
|

Re: moose collection extensions

Adrian Kuhn
Levente Uzonyi <leves@...> writes:

>   #equalsTo:
>     misleading name, #containsSameElementsAs: would be better IMO
>     #(1 1 2) equalsTo: #(2 1 1) ===> true

There is a #sameElements: in roel typer package. I think #sameElementsAs: and
 #sameSequenceAs: would be nice method names for methods that test for same
 elements and same elements in same order.

>   #flatCollect: -> #gather:
>   #flatCollectAsSet: -> #gather: + #asSet

NB: #gather always returns an array, should use species.

>   #groupBy: -> #groupBy:having:

Does not have the same behavior! #groupBy:having: requires that "keyBlock
 should return an Integer" whereas #groupedBy: works with any values (except
 nil) returned from the the block.  

>  #sum: -> #detectSum:

Short names and readability, anyone? Also the name is misleading, #detect:
 returns an element of the collection, #detectSum not. For maximum it makes
 sense to have both #detectMax: (which returns the element with the max value)
 and #max: (which returns the max value).

> SequenceableCollection >>
>   #shuffle -> #shuffled

NB: #shuffledBy: should use `i atRandom:` rather than `(1 to: i) atRandom:`
 to avoid creating an interval object for each element of the collection.

> OrderedCollection >>
>   #removeAtIndex: -> #removeAt:

Shorter name, nice! :)

--AA


_______________________________________________
Pharo-project mailing list
[hidden email]
http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project
Reply | Threaded
Open this post in threaded view
|

Re: moose collection extensions

Levente Uzonyi-2
On Sun, 27 Dec 2009, Adrian Kuhn wrote:

> Levente Uzonyi <leves@...> writes:
>
>>   #equalsTo:
>>     misleading name, #containsSameElementsAs: would be better IMO
>>     #(1 1 2) equalsTo: #(2 1 1) ===> true
>
> There is a #sameElements: in roel typer package. I think #sameElementsAs: and
> #sameSequenceAs: would be nice method names for methods that test for same
> elements and same elements in same order.
>
>>   #flatCollect: -> #gather:
>>   #flatCollectAsSet: -> #gather: + #asSet
>
> NB: #gather always returns an array, should use species.

Arrays are cool, they can contain any object. And I guess #gather: +
#asSet is faster than #flatCollectAsSet:.

>
>>   #groupBy: -> #groupBy:having:
>
> Does not have the same behavior! #groupBy:having: requires that "keyBlock
> should return an Integer" whereas #groupedBy: works with any values (except
> nil) returned from the the block.
>

keyBlock can return whatever it wants (and it doesn't have to be a block
at all), PluggableDictionary >> #integerDictionary is just a dictionary
that has better hash properties with integers from a small range than a
normal Dictionary, but the keys don't have to be integers. Example:

'abcdefgh' groupBy: #isVowel having: [ :e | true ]

>>  #sum: -> #detectSum:
>
> Short names and readability, anyone? Also the name is misleading, #detect:
> returns an element of the collection, #detectSum not. For maximum it makes
> sense to have both #detectMax: (which returns the element with the max value)
> and #max: (which returns the max value).

I agree that the name is wrong, but it's in the base image.

>
>> SequenceableCollection >>
>>   #shuffle -> #shuffled
>
> NB: #shuffledBy: should use `i atRandom:` rather than `(1 to: i) atRandom:`
> to avoid creating an interval object for each element of the collection.

I fixed that in squeak in october and I found the fix in my 1.1 pharo
image, though further improvement is possible (even ~85% speedup can
be achieved :)).


Levente

>
>> OrderedCollection >>
>>   #removeAtIndex: -> #removeAt:
>
> Shorter name, nice! :)
>
> --AA
>
>
> _______________________________________________
> Pharo-project mailing list
> [hidden email]
> http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project
>

_______________________________________________
Pharo-project mailing list
[hidden email]
http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project
Reply | Threaded
Open this post in threaded view
|

Re: moose collection extensions

Adrian Kuhn
Levente Uzonyi <leves@...> writes:

> >>   #flatCollect: -> #gather:
> >>   #flatCollectAsSet: -> #gather: + #asSet
> >
> > NB: #gather always returns an array, should use species.
>
> Arrays are cool, they can contain any object. And I guess #gather: +
> #asSet is faster than #flatCollectAsSet:.

#collect: uses species, so should #flatCollect:. This is not an issue of sets
 alone. When you work with your own custom collections (eg NodeList) you want
 all enumerations to return collections of *your* type.

For the #*asSet: methods, I really do love the #*:as: solution.

> keyBlock can return whatever it wants (and it doesn't have to be a block
> at all), PluggableDictionary >> #integerDictionary is just a dictionary
> that has better hash properties with integers from a small range than a
> normal Dictionary, but the keys don't have to be integers. Example:
>
> 'abcdefgh' groupBy: #isVowel having: [ :e | true ]

Then someone *please* fix the comment and provide #group(ed)By: without having
 clause. Also, again, the generated collection should be of species. When I
 group a node list I want node lists.

--AA


_______________________________________________
Pharo-project mailing list
[hidden email]
http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project
Reply | Threaded
Open this post in threaded view
|

Re: moose collection extensions

Stéphane Ducasse
In reply to this post by Levente Uzonyi-2
Levente you should realize that these methods have been defined and used
more than a couple of years ago.
They are used by a cool group of programmer and the infrastructure of Moose since
also a couple of years so I would not call them useless misleading
but thanks for you analysis :)

It is time to rewrite them.
But flatCollect: and flatCollectAsSet: names are more important than their implementation.

>> I just checked these and most of them are useless misleading or duplicate, like:
>
> Collection >>
> #collectAsSet: -> #collect:as: (ok, it's new in pharo)
> #equalsTo:
>   misleading name, #containsSameElementsAs: would be better IMO
>   #(1 1 2) equalsTo: #(2 1 1) ===> true

Yes I do not really like it

> #flatCollect: -> #gather:

the problem is that gather: does not convey its intention.
flatCollect: is much much better.

> #flatCollectAsSet: -> #gather: + #asSet

Is it not faster?

> #flatten --
>   misleading name, since it doesn't change the object, but returns
>   a new array and it's only flattening one level which is what #gather:
>   does. Tthere's a proper #flattened implementation in squeak treated
>   inbox if you're interested. (guess why it's not in the trunk)
> #groupBy: -> #groupBy:having:
> #sum: -> #detectSum:
>
> Symbol >>
> #value (same as super)
>
> SequenceableCollection >>
> #shuffle -> #shuffled
>
> OrderedCollection >>
> #removeAtIndex: -> #removeAt:
>
> (-> means that the extension on the left is the same as or worse than
> the already existing method(s) on the right)
>
> I guess you should shrink this package. :)
>
>
> Levente_______________________________________________
> Pharo-project mailing list
> [hidden email]
> http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project


_______________________________________________
Pharo-project mailing list
[hidden email]
http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project
Reply | Threaded
Open this post in threaded view
|

Re: moose collection extensions

Stéphane Ducasse
In reply to this post by Adrian Kuhn
>>>>  #flatCollect: -> #gather:
>>>>  #flatCollectAsSet: -> #gather: + #asSet
>>>
>>> NB: #gather always returns an array, should use species.
>>
>> Arrays are cool, they can contain any object. And I guess #gather: +
>> #asSet is faster than #flatCollectAsSet:.
>
> #collect: uses species, so should #flatCollect:. This is not an issue of sets
> alone. When you work with your own custom collections (eg NodeList) you want
> all enumerations to return collections of *your* type.

YES!!!
>
> For the #*asSet: methods, I really do love the #*:as: solution.

Adrian if you want publish a new version of the package in the tasksForces.
Now this is really central to moose so all the tests should pass.

>> keyBlock can return whatever it wants (and it doesn't have to be a block
>> at all), PluggableDictionary >> #integerDictionary is just a dictionary
>> that has better hash properties with integers from a small range than a
>> normal Dictionary, but the keys don't have to be integers. Example:
>>
>> 'abcdefgh' groupBy: #isVowel having: [ :e | true ]
>
> Then someone *please* fix the comment and provide #group(ed)By: without having
> clause. Also, again, the generated collection should be of species. When I
> group a node list I want node lists.

I agree.
Publish code :)



>
> --AA
>
>
> _______________________________________________
> Pharo-project mailing list
> [hidden email]
> http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project


_______________________________________________
Pharo-project mailing list
[hidden email]
http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project
Reply | Threaded
Open this post in threaded view
|

Re: moose collection extensions

Stéphane Ducasse
In reply to this post by Levente Uzonyi-2
> Levente Uzonyi <leves@...> writes:
>>
>>>  #equalsTo:
>>>    misleading name, #containsSameElementsAs: would be better IMO
>>>    #(1 1 2) equalsTo: #(2 1 1) ===> true
>>
>> There is a #sameElements: in roel typer package. I think #sameElementsAs: and
>> #sameSequenceAs: would be nice method names for methods that test for same
>> elements and same elements in same order.

See the other thread
I would like to have
        sameSequenceOfElements:
        and sameElements:

>>
>>>  #flatCollect: -> #gather:
>>>  #flatCollectAsSet: -> #gather: + #asSet
>>
>> NB: #gather always returns an array, should use species.
>
> Arrays are cool, they can contain any object. And I guess #gather: +
> #asSet is faster than #flatCollectAsSet:.


No Array are not cool. They are useful in specific ocassion.
 flatCollect: and other should work on OrderedCollection, Set, SortedCollection
In Moose we have special collection like entities and they should work also on them, and returns
the same kind of collection.

>
>>
>>>  #groupBy: -> #groupBy:having:
>>
>> Does not have the same behavior! #groupBy:having: requires that "keyBlock
>> should return an Integer" whereas #groupedBy: works with any values (except
>> nil) returned from the the block.
>>
>
> keyBlock can return whatever it wants (and it doesn't have to be a block
> at all), PluggableDictionary >> #integerDictionary is just a dictionary
> that has better hash properties with integers from a small range than a
> normal Dictionary, but the keys don't have to be integers. Example:
>
> 'abcdefgh' groupBy: #isVowel having: [ :e | true ]
>
>>> #sum: -> #detectSum:
>>
>> Short names and readability, anyone? Also the name is misleading, #detect:
>> returns an element of the collection, #detectSum not. For maximum it makes
>> sense to have both #detectMax: (which returns the element with the max value)
>> and #max: (which returns the max value).
>
> I agree that the name is wrong, but it's in the base image.
>
>>
>>> SequenceableCollection >>
>>>  #shuffle -> #shuffled
>>
>> NB: #shuffledBy: should use `i atRandom:` rather than `(1 to: i) atRandom:`
>> to avoid creating an interval object for each element of the collection.
>
> I fixed that in squeak in october and I found the fix in my 1.1 pharo
> image, though further improvement is possible (even ~85% speedup can
> be achieved :)).
>
>
> Levente
>
>>
>>> OrderedCollection >>
>>>  #removeAtIndex: -> #removeAt:
>>
>> Shorter name, nice! :)
>>
>> --AA
>>
>>
>> _______________________________________________
>> Pharo-project mailing list
>> [hidden email]
>> http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project
>>
>
> _______________________________________________
> Pharo-project mailing list
> [hidden email]
> http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project


_______________________________________________
Pharo-project mailing list
[hidden email]
http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project
Reply | Threaded
Open this post in threaded view
|

Re: moose collection extensions

Stéphane Ducasse
In reply to this post by Stéphane Ducasse
Lukas

I know that you also have a cool lib of other highorder function.
Where can we find it?

Stef

On Dec 27, 2009, at 5:26 PM, Stéphane Ducasse wrote:

> hi
>
> here are the collection extensions we use in Moose.
> I copied them to PharoTaskForces so that we can discuss and tweak the code if wanted.
>
> My favorite is
> flatCollect:/flatCollectAsSet:
> groupedBy:
>
> There are really useful.
>
> Stef
>
>
> testFlatCollectArray
> "self debug: #testFlatCollectArray"
>
> self assert: ((#((1 2) (3 4) (5 3)) flatCollect: [ :each ]) = #(1 2 3 4 5 3)).
> self assert: ((#((1 2) (2 3) (1 3 4)) flatCollect: [:each]) = #(1 2 2 3 1 3 4)).
>
> self assert: ((#((1 2) (2 3) () ()) flatCollect: [:each]) = #(1 2 2 3)).
>
> self assert: ((#((1 2) (2 3) (1 3 4)) flatCollect: [:each| Array with: each])
> =  #(#(1 2) #(2 3) #(1 3 4))).
>
> self assert: ((#((1 2) (2 3) (1 3 4)) flatCollect: [:each| Set with: each])
> =  #(#(1 2) #(2 3) #(1 3 4))).
>
>
> testFlatCollectSet
> "self debug: #testFlatCollectSet"
>
> self assert: ((#((1 2) (1 2) (1 3 4)) asSet  flatCollect: [:each]) = #(1 1 2 3 4) asSet).
> self assert: ((#() asSet flatCollect: [:each]) = #() asSet).
>
> self assert:  ((#((1 2) () (1 3 4)) asSet  flatCollect: [:each]) = #(1 1 2 3 4) asSet).
> self assert:  ((#((1 2) #((99)) (1 3 4)) asSet  flatCollect: [:each])
> = #(1 1 2 3 4 (99)) asSet).
> self assert:  ((#((1 2) #(()) (1 3 4)) asSet  flatCollect: [:each])
> = #(1 1 2 3 4 ()) asSet).
>
> testCollectAsSet
> "self debug: #testCollectAsSet"
>
> self assert: ((#() collectAsSet: [:each | each odd]) = Set new).
> self assert: (#(1 2 3 4 5 6) collectAsSet: [:each | each odd])
> = (Set with: true with: false).
> self assert: (#(1 3 5 7 9 11) collectAsSet: [:each | each odd])
> = (Set with: true).
>
> self assert: (#(1 2 3 4 5 4 3 2 1) collectAsSet: [:each | each]) = (1 to: 5) asSet.
>
>
> testGroupedByArray
> "self debug: #testGroupedByArray"
>
> | res |
> res := #(1 2 3 4 5) groupedBy: [:each | each odd].
> self assert:   (res at: true) = #(1 3 5).
> self assert: (res at: false) = #(2 4)
>
>
>
> Set>>flatCollect: aBlock
>
>
> ^self flatCollectAsSet: aBlock
>
>
> Symbol>>value
> "Allow this object to act as a ValueHolder on itself."
>
> ^self
>
> OrderedCollection>>removeAtIndex: anIndex
> "Remove the element of the collection at position anIndex.  Answer the object removed."
>
> | obj |
> obj := self at: anIndex.
> self removeIndex: anIndex + firstIndex - 1.
> ^obj
>
> Collection
> ==============================
>
> collectAsSet: aBlock
> "Evaluates aBlock for each element of the receiver and collects
> the resulting values into a Set."
>
> "This is an efficient shorthand for [ (self collect: aBlock) asSet ]."
> "originally developed by a. kuhn and released under MIT."
>
> ^self inject: Set new into: [ :set :each |
> set add: (aBlock value: each); yourself ].
>
>
> copyEmpty: aSize
> "Answer a copy of the receiver that contains no elements.
>
> This method should be redefined in subclasses that add
> instance variables, so that the state of those variables
> is preserved"
>
> ^self class new: aSize
>
>
> flatCollect: aBlock
> "Evaluate aBlock for each of the receiver's elements and answer the
> list of all resulting values flatten one level. Assumes that aBlock returns some kind
> of collection for each element. Equivalent to the lisp's mapcan"
> "original written by a. Kuhn and released under MIT"
>
> | stream |
> self isEmpty ifTrue: [ ^ self copy ].
> stream := (self species new: 0) nsWriteStream.
> self do: [ :each | stream nextPutAll: (aBlock value: each) ].
> ^ stream contents
>
> flatCollectAsSet: aBlock
> "Evaluate aBlock for each of the receiver's elements and answer the
> list of all resulting values flatten one level. Assumes that aBlock returns some kind
> of collection for each element. Equivalent to the lisp's mapcan"
>
> "original written by a. Kuhn and released under MIT"
>
> | set |
> self isEmpty ifTrue: [^self copy ].
> set := Set new.
> self do: [ :each |
> set addAll: (aBlock value: each) ].
> ^set
>
>
> flatten
> "Recursively collect each non-collection element of the receiver and its descendant
> collections.  Please note, this implementation assumes that strings are to be treated
> as objects rather than as collection."
>
> ^self gather: [ :each ]
>
> groupedBy: aBlock
> "Return a dictionary whose keys are the result of evaluating aBlock for all elements in
> the collection, and the value for each key is the collection of elements that evaluated
> to that key. e.g.
>     #(1 2 3 4 5) groupedBy: [:each | each odd]
>   a Dictionary  
>     true ---> #( 1 3 5)
>     false --> #(2 4)
> originally developed by a. kuhn and released under MIT."
>
> | result |
> result := Dictionary new.
> self do:
> [:each | | key collection |
> key := aBlock value: each.
> collection := result at: key ifAbsentPut: [OrderedCollection new].
> collection add: each].
> self species ~~ OrderedCollection ifTrue:
> ["Convert the result collections to be the right type.
>  Note that it should be safe to modify the dictionary
>  while iterating because we only replace values for existing keys"
> result keysAndValuesDo:
> [:key :value | result at: key put: (self species withAll: value)]].
>
> ^result
>
> includesAll: aCollection
> "Answer true if the receiver includes all elements of aCollection with at
> least as many occurrences as in aCollection. For a less strict comparison
> please refer to supersetOf: and its inverse subsetOf:."
>
>
> ^(aCollection isCollection) and: [
> aCollection size <= self size and: [
> aCollection allSatisfy: [ :each |
> (aCollection occurrencesOf: each) <= (self occurrencesOf: each) ]]]
>
> nilSafeGroupedBy: aBlock
> ^ self groupedBy: [ :each |
> | value |
> value := aBlock value: each.
> value ifNil: [ UndefinedObject ].
> ]
>
> selectAsSet: aBlock
> "Evaluate aBlock with each of the receiver's elements as the argument.
> Collect into a new set, only those elements for which
> aBlock evaluates to true.  Answer the new collection."
>
> | newSet |
> newSet := Set new.
> self do: [:each | (aBlock value: each) ifTrue: [newSet add: each]].
> ^newSet
>
> shuffle
> "Swaps the receiver's elements at random."
>
> self shuffle: (self size * self size log) asInteger
>
> sum: aSymbolOrBlock
>
> ^self
> inject: 0
> into: [:sum :each | sum + (aSymbolOrBlock value: each)]
>
> shuffle: times
> "Swaps random elements of the receiver."
>
> | size random |
> size := self size.
> random := Random new.
> times timesRepeat: [
> self swap: (random next * size) floor + 1 with: (random next * size) floor + 1
> ].
>
>
>
>
> _______________________________________________
> Pharo-project mailing list
> [hidden email]
> http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project


_______________________________________________
Pharo-project mailing list
[hidden email]
http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project
Reply | Threaded
Open this post in threaded view
|

Re: moose collection extensions

Levente Uzonyi-2
In reply to this post by Stéphane Ducasse
On Mon, 28 Dec 2009, Stéphane Ducasse wrote:

> Levente you should realize that these methods have been defined and used
> more than a couple of years ago.

Most of the methods I suggested were added to squeak long before they
started working on the project.

> They are used by a cool group of programmer and the infrastructure of Moose since
> also a couple of years so I would not call them useless misleading

I guess I missed a comma here, I meant useless or misleading.

> but thanks for you analysis :)
>
> It is time to rewrite them.
> But flatCollect: and flatCollectAsSet: names are more important than their implementation.
>
>>> I just checked these and most of them are useless misleading or duplicate, like:
>>
>> Collection >>
>> #collectAsSet: -> #collect:as: (ok, it's new in pharo)
>> #equalsTo:
>>   misleading name, #containsSameElementsAs: would be better IMO
>>   #(1 1 2) equalsTo: #(2 1 1) ===> true
>
> Yes I do not really like it
>
>> #flatCollect: -> #gather:
>
> the problem is that gather: does not convey its intention.
> flatCollect: is much much better.
>
>> #flatCollectAsSet: -> #gather: + #asSet
>
> Is it not faster?
>
I don't think that growing a Set is faster than growing an Array, then
converting it to a Set, but let's see the numbers:

"Prepare an array with 10000 elements, each element is an array with one
integer. 10% is duplicate."
data := (1 to: 9000) collect: [ :each | { SmallInteger maxVal atRandom }
].
data := data, (data last: 1000).
data := data shuffled.

(1 to: 10) collect: [ :run |
  [ (data gather: [ :each | each ]) asSet ] timeToRun ]. ===> #(14 15 14 15 14 14 15 14 15 14).

(1 to: 10) collect: [ :run |
  [ data flatCollectAsSet: [ :each | each ] ] timeToRun ]. ===> #(29 29 29 28 29 28 28 29 29 29)


Levente

>> #flatten --
>>   misleading name, since it doesn't change the object, but returns
>>   a new array and it's only flattening one level which is what #gather:
>>   does. Tthere's a proper #flattened implementation in squeak treated
>>   inbox if you're interested. (guess why it's not in the trunk)
>> #groupBy: -> #groupBy:having:
>> #sum: -> #detectSum:
>>
>> Symbol >>
>> #value (same as super)
>>
>> SequenceableCollection >>
>> #shuffle -> #shuffled
>>
>> OrderedCollection >>
>> #removeAtIndex: -> #removeAt:
>>
>> (-> means that the extension on the left is the same as or worse than
>> the already existing method(s) on the right)
>>
>> I guess you should shrink this package. :)
>>
>>
>> Levente_______________________________________________
>> Pharo-project mailing list
>> [hidden email]
>> http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project
>
>
> _______________________________________________
> Pharo-project mailing list
> [hidden email]
> http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project
>
_______________________________________________
Pharo-project mailing list
[hidden email]
http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project
12