[squeak-dev] RSChartExample almost all working.

Tobias Pape Das.Linux at gmx.de
Sat Oct 24 15:56:24 UTC 2020


> On 24.10.2020, at 16:16, H. Hirzel <hannes.hirzel at gmail.com> wrote:
> 
> Hello
> 
> Regarding the missing Squeak method flatCollect: in
> 
> Collection, Dictionary, SequenceableCollection, SortedCollection




> 
> This could be a method to include in Squeak trunk as well. It has been
> discussed in Pharo in 2009 see mail copied in below with a summary
> flatCollect: and associated test cases.


#gather: has been around since 2002, why not just use that?


	#((1 2) (3 4) (5 3)) gather: [:ea | ea] "=>  #(1 2 3 4 5 3)"
	#((1 2) (2 3) () ()) gather: [:ea | ea] "=>  #(1 2 2 3)"

etc.
I really do not like the "flatten" analogy too much. That said, we do have #flatten/#flattened

	#((1 2) (2 3) () ()) flatten "=> #(1 2 2 3)"

This is different in that is has special handling of Strings.

Best regards
	-Tobias



> 
> But it is probably better to copy the code from a current Pharo
> implementation and adapt it.
> 
> --Hannes
> 
> ---------------------------------------------
> Stéphane Ducasse<stephane.ducasse at inria.fr>	Sun, Dec 27, 2009 at 4:26 PM
> Reply-To: Pharo-project at lists.gforge.inria.fr
> To: "Pharo-project at lists.gforge.inria.fr Development"
> <Pharo-project at lists.gforge.inria.fr>
> Reply | Reply to all | Forward | Print | Delete | Show original
> 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
>        ].
> 
> 
> 
> 
> 
> On 10/24/20, gettimothy via Squeak-dev
> <squeak-dev at lists.squeakfoundation.org> wrote:
>> Hi Folks,
>> 
>> 
>> 
>> I am going through the RSChartExample examples.
>> 
>> 
>> 
>> Most are working.
>> 
>> 
>> 
>> The one below prefaced with an 'x' are not working , those without the 'x'
>> are working...
>> 
>> 
>> 
>> 
>> 
>> RSChartExample new example01Markers open.
>> 
>> RSChartExample new example02ScatterPlot open.
>> 
>> RSChartExample new example03Plot open.
>> 
>> RSChartExample new example04WithTick open.
>> 
>> RSChartExample new example05WithTick open.
>> 
>> RSChartExample new example06CustomNumberOfTicks open.
>> 
>> RSChartExample new example07AdjustingFontSize open.
>> 
>> RSChartExample new example08TwoCharts open.
>> 
>> RSChartExample new example09LinearSqrtSymlog open.
>> 
>> RSChartExample new example10BarPlot open.
>> 
>> RSChartExample new example11BarplotCombinedWithLine open.
>> 
>> RSChartExample new example12ScatterPlotAndNormalizer open.
>> 
>> xRSChartExample new example13AreaPlot open.
>> 
>> xRSChartExample new example14AreaPlotWithError open.
>> 
>> xRSChartExample new example15AreaBox open.
>> 
>> xRSChartExample new example16Series open.
>> 
>> xRSChartExample new example17CLPvsUSD open.
>> 
>> xRSChartExample new example18Animation open.
>> 
>> 
>> 
>> 
>> 
>> 
>> 
>> The ones with the 'x' are failing on a method I have imported from pharo
>> 
>> 
>> 
>> Collection, Dictionary, SequenceableCollection, SortedCollection need to
>> implement flatCollect:
>> 
>> Collection >>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"
>> 
>> 
>> 
>> "( #((3 4) (1 2)) flatCollect: [:each | each ] )>>> #(3 4 1 2)"
>> 
>> "( #(3 4 1 2) flatCollect: [:each | { each } ] ) >>> #(3 4 1 2)"
>> 
>> 
>> 
>> ^ self flatCollect: aBlock as: self species
>> 
>> 
>> 
>> etc...
>> 
>> 
>> 
>> The error I am getting is an 'Attempt to index a non-existent element in an
>> OrderedCollection from the flatCollect in SequenceableCollection...(The
>> breaks and method vars are mine as I attempt to grok this)
>> 
>> 
>> 
>> SequenceableCollection >> 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. optimized version for Sequencable Collection
>> and subclasses
>> 
>> implementing #writeStream"
>> 
>> 
>> 
>> "(#( (2 -3) (4 -5) #(-6)) flatCollect: [ :e | e abs  ]) >>> #(2 3 4 5 6)"
>> 
>> 
>> 
>> "(#( (2 -3) #((4 -5)) #(-6)) flatCollect: [ :e | e abs  ]) >>> #(2 3 #(4 5)
>> 6)"
>> 
>> |x i|
>> 
>> self isEmpty
>> 
>> ifTrue: [ ^ self copy ].
>> 
>> i := 0.
>> 
>> x := self species
>> 
>> new: 0
>> 
>> streamContents: [ :stream | self do: [ :each |
>> 
>> i := i +1.
>> 
>> stream nextPutAll: (aBlock value: each).  <--BARFS HERE
>> 
>> self break.  <--NEVER REACHED
>> 
>> ]].
>> 
>> 
>> 
>> ^x.
>> 
>> 
>> 
>> 
>> 
>> 
>> 
>> The above fails in
>> 
>> 
>> 
>> SequenceableCollection >> replaceFrom: start to: stop with: replacement
>> startingAt: repStart
>> 
>> "This destructively replaces elements from start to stop in the receiver
>> 
>> starting at index, repStart, in the sequenceable collection,
>> 
>> replacementCollection. Answer the receiver. No range checks are
>> 
>> performed."
>> 
>> 
>> 
>> | index repOff |
>> 
>> repOff := repStart - start.
>> 
>> index := start - 1.
>> 
>> [(index := index + 1) <= stop]
>> 
>> whileTrue: [self at: index put: (replacement at: repOff + index)]   <- BARF
>> HERE
>> 
>> 
>> 
>> 
>> 
>> at the at: put:
>> 
>> 
>> 
>> I will be figuring this out next.
>> 
>> 
>> 
>> 
>> 
>> FWIW, using the Git Browser on the pharo repo...I make the pharo9 "current'
>> and then am able to get GradientPaint and required classes into Squeak....
>> 
>> 
>> 
>> steps are these:
>> 
>> 
>> 
>> 
>> 
>> From Git Browser....
>> 
>> 
>> 
>> Switch to Pharo9 branch.
>> 
>> 
>> 
>> src/Athens-Core browse Edition in Selected Version
>> 
>> in the browser...Athens-Core-Paints->AthensAbstractPaint
>> 
>> load class.
>> 
>> same for, GradientPaint  LinearGradientPaint and RadialGradientPaint
>> 
>> 
>> 
>> anyhoo, progress.
>> 
>> 
>> 
>> 
>> 
>> Also, the Morphic folks, once we get this working, will probably want to
>> poke around to make the BalloonMorphs behave.
> 




More information about the Squeak-dev mailing list