Arquivo do mês: março 2012

Mario Wolczko Graph Library port for Pharo

Fiz o porting da Graph Library para o Pharo Smalltalk. Havia um port para Squeak com origem em VAStGoodies. O código para o Squeak usava _ em vez de := nas atribuições. Uma diferença que também causou erros de sintaxe no Pharo foi a atribuição a variáveis que são parâmetros em BlockClosures. No Squeak é permitido e no Pharo não.

O código abaixo é aceito no Squeak:

mas no Pharo deve ser:

Os file-outs seguem abaixo:

Graphs-Iterator.st

Collection subclass: #Iterator
	instanceVariableNames: 'block'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphs-Iterator'!
!Iterator commentStamp: '' prior: 0!
An Iterator is a read-only collection that evaluates a block to yield the elements of the collection.!

!Iterator methodsFor: 'adding'!
add: anObject
	"Iterators are read-only"
	self shouldNotImplement! !

!Iterator methodsFor: 'converting'!
asOrderedCollection
	"Answer a new instance of OrderedCollection whose elements are the elements of
	the receiver.  The order in which elements are added depends on the order in
	which the receiver enumerates its elements.  In the case of unordered collections,
	the ordering is not necessarily the same for multiple requests for the conversion."

	| anOrderedCollection |
	anOrderedCollection := OrderedCollection new.
	self do: [:each | anOrderedCollection addLast: each].
	^anOrderedCollection! !

!Iterator methodsFor: 'private'!
block: aBlock
	block := aBlock! !

!Iterator methodsFor: 'private'!
species
	^OrderedCollection! !

!Iterator methodsFor: 'enumerating'!
do: aBlock
	block value: aBlock! !

!Iterator methodsFor: 'enumerating'!
findFirst: aBlock
	"Answer the index of the first element of the receiver
	for which aBlock evaluates as true."

	| index |
	index := 1.
	self do: [ :el | (aBlock value: el) ifTrue: [^index].  index := index + 1].
	^0! !

!Iterator methodsFor: 'enumerating'!
findLast: aBlock
	"Answer the index of the last element of the receiver
	for which aBlock evaluates as true."

	| index last |
	index := 1.
	last := 0.
	self do: [ :el | (aBlock value: el) ifTrue: [last := index].  index := index + 1].
	^last! !

!Iterator methodsFor: 'enumerating'!
keysAndValuesDo: aBlock
	"Evaluate aBlock with each of the receiver's key/value pairs
	(e.g. indexes and elements) as the arguments."

	| index |
	index := 1.
	self do: [:el | aBlock value: index value: el.  index := index + 1]! !

!Iterator methodsFor: 'accessing'!
identityIndexOf: anElement
	"Answer the identity index of anElement within the receiver.  If the receiver does
	not contain anElement, answer 0."

	^self identityIndexOf: anElement ifAbsent: [0]! !

!Iterator methodsFor: 'accessing'!
identityIndexOf: anElement ifAbsent: exceptionBlock
	"Answer the identity index of anElement within the receiver.  If the receiver does
	not contain anElement, answer the result of evaluating the exceptionBlock."

	| index |
	index := 1.
	self do: [ :el | el == anElement ifTrue: [^index].  index := index + 1].
	^exceptionBlock value! !

!Iterator methodsFor: 'accessing'!
indexOf: anElement
	"Answer the index of anElement within the receiver.  If the receiver does
	not contain anElement, answer 0."

	^self indexOf: anElement ifAbsent: [0]! !

!Iterator methodsFor: 'accessing'!
indexOf: anElement ifAbsent: exceptionBlock
	"Answer the index of anElement within the receiver.  If the receiver does
	not contain anElement, answer the result of evaluating the exceptionBlock."

	| index |
	index := 1.
	self do: [ :el | el = anElement ifTrue: [^index].  index := index + 1].
	^exceptionBlock value! !

!Iterator methodsFor: 'removing'!
remove: oldObject ifAbsent: anExceptionBlock
	"Iterators are read-only."
	self shouldNotImplement! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

Iterator class
	instanceVariableNames: ''!

!Iterator class methodsFor: 'instance creation' stamp: 'len 2/18/2003 23:04'!
on: aBlock
	^self new block: aBlock fixTemps! !

!Iterator class methodsFor: 'instance creation'!
on: collection msg: msg
	^self new block: [ :aBlock | collection perform: msg with: aBlock]! !

Graphs-SqueakEnh-Misc.st

PackageInfo subclass: #CollectionMiscInfo
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphs-SqueakEnh-Misc'!

!CollectionMiscInfo methodsFor: 'as yet unclassified' stamp: 'sam 10/19/2004 16:46'!
methodCategoryPrefix
^ '*squeakenh-misc'! !

!CollectionMiscInfo methodsFor: 'as yet unclassified' stamp: 'sam 6/16/2004 19:21'!
readmeText
^ 'Collections-Misc : A variety of methods and classes which add functionality to collections, from Mario Wolczko, maintainer: lnotarfrancesco@yahoo.com. Ported from the old collections-misc goodie by Mario Wolczko.
This goodie contains a variety of methods and classes which
add functionality to collections.  Nothing is particularly startling,
but you may find the odd useful method.  I use these quite a lot.'! !

Dictionary variableSubclass: #DictionaryWithDefault
	instanceVariableNames: 'defaultBlock'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphs-SqueakEnh-Misc'!
!DictionaryWithDefault commentStamp: '' prior: 0!
A DictionaryWithDefault is like a Dictionary, except that it is initialized with a value (or block) that is (yields) the default value for any key.

A subsequent access to a key that has not been explicitly inserted into the dictionary will yield the default value (calculated by executing the block), and insert the (key,default value) association into the dictionary.!

!DictionaryWithDefault methodsFor: 'accessing'!
associationAt: key
	"Answer the association at key."

	^super associationAt: key ifAbsent:
		[| value |
		value := defaultBlock value: key.
		super at: key put: value.
		super associationAt: key]! !

!DictionaryWithDefault methodsFor: 'accessing'!
at: key
	"Answer the value at key."

	^super at: key ifAbsent:
		[| value |
		value := defaultBlock value: key.
		super at: key put: value.
		super at: key]! !

!DictionaryWithDefault methodsFor: 'copying'!
copyEmpty: aSize
	^(super copyEmpty: aSize) defaultBlock: defaultBlock! !

!DictionaryWithDefault methodsFor: 'initialization'!
defaultBlock: aBlock
	defaultBlock := aBlock! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

DictionaryWithDefault class
	instanceVariableNames: ''!

!DictionaryWithDefault class methodsFor: 'examples'!
example
	"DictionaryWithDefault example"
	"| d |
	d := DictionaryWithDefault example.
	d at: #foo put: 2.
	Transcript show: (d at: #foo) printString ; space ; show: (d at: #bar) printString"
	"A dictionary of symbols whose default value is the number of characters in the symbol."
	^DictionaryWithDefault newWithDefaultValueBlock: [ :key | key size]! !

!DictionaryWithDefault class methodsFor: 'examples'!
example2
	"DictionaryWithDefault example2"
	"| d |
	d := DictionaryWithDefault example2.
	#(1 2 3 5 7 11 13 17 19) do: [ :n | d at: n put: 1].
	1 to: 20 do: [ :n | Transcript show: (d at: n) printString ; space]"
	"A dictionary of whose default value is 0."
	^DictionaryWithDefault newWithDefaultValue: 0! !

!DictionaryWithDefault class methodsFor: 'instance creation'!
newIdentity
	"Default map is identity."
	^self newWithDefaultValueBlock: [ 😡 | x]! !

!DictionaryWithDefault class methodsFor: 'instance creation'!
newWithDefaultValue: aValue
	^super new defaultBlock: [ :ignored | aValue]! !

!DictionaryWithDefault class methodsFor: 'instance creation'!
newWithDefaultValueBlock: aBlock
	^super new defaultBlock: aBlock! !

Set variableSubclass: #KeyedSet
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphs-SqueakEnh-Misc'!
!KeyedSet commentStamp: '' prior: 0!
A KeyedSet has the ability to locate an element of the set based on its hash, using at:.!

!KeyedSet methodsFor: 'accessing' stamp: 'len 2/12/2003 16:29'!
at: key
	^self at: key ifAbsent: [self error: 'key not found']! !

!KeyedSet methodsFor: 'accessing' stamp: 'len 2/12/2003 16:45'!
at: key ifAbsent: aBlock
	| index |
	^ (index _ self scanFor: key) = 0
		ifTrue: [^ aBlock value]
		ifFalse: [(array at: index) ifNil: [aBlock value]]! !

IdentityDictionary variableSubclass: #IdentityDictionaryWithDefault
	instanceVariableNames: 'defaultBlock'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphs-SqueakEnh-Misc'!
!IdentityDictionaryWithDefault commentStamp: '' prior: 0!
An IdentityDictionaryWithDefault is like an IdentityDictionary, except that it is initialized with a value (or block) that is (yields) the default value for any key.

A subsequent access to a key that has not been explicitly inserted into the dictionary will yield the default value (calculated by executing the block), and insert the (key,default value) association into the dictionary.

See DictionaryWithDefault for examples.!

!IdentityDictionaryWithDefault methodsFor: 'accessing'!
associationAt: key
	"Answer the association at key."

	^super associationAt: key ifAbsent:
		[| value |
		value := defaultBlock value: key.
		super at: key put: value.
		super associationAt: key]! !

!IdentityDictionaryWithDefault methodsFor: 'accessing'!
at: key
	"Answer the value at key."

	^super at: key ifAbsent:
		[| value |
		value := defaultBlock value: key.
		super at: key put: value.
		super at: key]! !

!IdentityDictionaryWithDefault methodsFor: 'copying'!
copyEmpty: aSize
	^(super copyEmpty: aSize) defaultBlock: defaultBlock! !

!IdentityDictionaryWithDefault methodsFor: 'initialization'!
defaultBlock: aBlock
	defaultBlock := aBlock! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

IdentityDictionaryWithDefault class
	instanceVariableNames: ''!

!IdentityDictionaryWithDefault class methodsFor: 'instance creation'!
newIdentity
	"Default map is identity."
	^self newWithDefaultValueBlock: [ 😡 | x]! !

!IdentityDictionaryWithDefault class methodsFor: 'instance creation'!
newWithDefaultValue: aValue
	^super new defaultBlock: [ :ignored | aValue]! !

!IdentityDictionaryWithDefault class methodsFor: 'instance creation'!
newWithDefaultValueBlock: aBlock
	^super new defaultBlock: aBlock! !

Graphs-Collections-Graphs.st

Object subclass: #Dijkstra
	instanceVariableNames: 'graph source predecessor distance'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphs-Collections-Graphs'!

!Dijkstra methodsFor: 'as yet unclassified'!
distanceTo: t1
	^ distance at: t1! !

!Dijkstra methodsFor: 'as yet unclassified'!
eccentricity
	^ distance max! !

!Dijkstra methodsFor: 'as yet unclassified'!
graph: t1 source: t2
	graph := t1.
	source := t2.
	self run! !

!Dijkstra methodsFor: 'as yet unclassified'!
run
	| t1 t2 t3 |
	graph
		do: [:t4 |
			distance at: t4 put: Float infinity.
			predecessor at: t4 put: nil].
	distance at: source put: 0.
	t1 := Heap
				sortBlock: [:t5 :t6 | (distance at: t5)
						 t3
						ifTrue: [distance at: t4 put: t3.
							predecessor at: t4 put: t2]]]! !

!Dijkstra methodsFor: 'as yet unclassified'!
shortestPathTo: t1
	| t2 t3 t4 |
	t2 := OrderedCollection new.
	[t3 := t1.
	t2 add: t3.
	t4 := t4 at: t3.
	source = t4]
		whileFalse: [t3 := t4].
	^ t2! !

Object subclass: #GraphNode
	instanceVariableNames: 'value'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphs-Collections-Graphs'!

!GraphNode methodsFor: 'comparing'!
= t1
	^ t1 = value! !

!GraphNode methodsFor: 'comparing'!
hash
	^ value hash! !

!GraphNode methodsFor: 'accessing edges'!
clusteringCoefficient
	| t1 t2 |
	t1 := Set new.
	self
		neighborsDo: [:t3 | self
				neighborsDo: [:t4 | t3 ~= t4
						ifTrue: [(t3 outNeighbors includes: t4)
								ifTrue: [t1 add: t3 value @ t4 value]]]].
	t2 := self outNeighbors size.
	^ t1 size / (t2 * (t2 - 1))! !

!GraphNode methodsFor: 'accessing edges'!
degree
	self subclassResponsibility! !

!GraphNode methodsFor: 'accessing edges'!
neighborsAndLabelsDo: t1
	self
		neighborsDo: [:t2 | t1 value: t2 value: nil]! !

!GraphNode methodsFor: 'accessing edges'!
neighborsDo: t1
	self subclassResponsibility! !

!GraphNode methodsFor: 'accessing edges'!
outNeighbors
	self subclassResponsibility! !

!GraphNode methodsFor: 'testing edges'!
hasEdgeTo: t1
	self subclassResponsibility! !

!GraphNode methodsFor: 'testing edges'!
isLeaf
	^ self degree = 0! !

!GraphNode methodsFor: 'testing'!
isLabelled
	self subclassResponsibility! !

!GraphNode methodsFor: 'enumerating'!
markDo: t1
	| t2 t3 t4 |
	t2 := Set with: self.
	t3 := Set new.
	[t2 isEmpty]
		whileFalse: [t4 := t2 anyOne.
			t3 add: t4.
			t1 value: t4.
			t4
				neighborsDo: [:t5 | (t3 includes: t5)
						ifFalse: [t2 add: t5]].
			t2 remove: t4]! !

!GraphNode methodsFor: 'enumerating'!
walkPre: t1 post: t2
	t1 value: self.
	self
		neighborsDo: [:t3 | t3 walkPre: t1 post: t2].
	t2 value: self! !

!GraphNode methodsFor: 'printing'!
printOn: t1
	t1 nextPut: $[;
		 print: value;
		 nextPut: $]! !

!GraphNode methodsFor: 'accessing value'!
value
	^ value! !

!GraphNode methodsFor: 'accessing value'!
value: t1
	value := t1! !

Object subclass: #DAGFrontier
	instanceVariableNames: 'frontier bag'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphs-Collections-Graphs'!

!DAGFrontier methodsFor: 'accessing'!
frontier
	^ frontier! !

!DAGFrontier methodsFor: 'initialization'!
frontier: t1 bag: t2
	frontier := t1.
	bag := t2! !

!DAGFrontier methodsFor: 'advancing'!
remove: t1
	frontier remove: t1.
	t1
		neighborsDo: [:t2 | (bag removeOne: t2)
					= 0
				ifTrue: [frontier add: t2]].
	^ t1! !

!DAGFrontier methodsFor: 'advancing'!
removeAll: t1
	t1
		do: [:t2 | self remove: t2]! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

DAGFrontier class
	instanceVariableNames: ''!

!DAGFrontier class methodsFor: 'instance creation'!
frontierOn: t1
	| t2 t3 |
	t3 := t1 rootNodes asOrderedCollection.
	t2 := Bag new.
	t1
		nodesDo: [:t4 | t4
				neighborsDo: [:t5 | t2 add: t5]].
	^ self new frontier: t3 bag: t2! !

Object subclass: #Graph
	instanceVariableNames: 'nodes nodeCreator type random'
	classVariableNames: 'InitializationBlocks'
	poolDictionaries: ''
	category: 'Graphs-Collections-Graphs'!

!Graph methodsFor: 'adding'!
add: t1
	^ nodes add: t1! !

!Graph methodsFor: 'adding'!
addEdge: t1
	| t2 |
	self addEdgeFrom: t1 key to: t1 value.
	self triggerEvent: #addEdge: with: t1.
	type = #(#undirected )
		ifTrue: [t2 := t1 value -> t1 key.
			self addEdgeFrom: t1 value to: t1 key.
			self triggerEvent: #addEdge: with: t2].
	^ t1! !

!Graph methodsFor: 'adding'!
addEdge: t1 label: t2
	self
		addEdgeFrom: t1 key
		to: t1 value
		label: t2.
	^ t1! !

!Graph methodsFor: 'adding'!
addEdgeFrom: t1 to: t2
	| t3 t4 |
	t3 := self addNode: t1.
	t4 := self addNode: t2.
	t3 addNeighbor: t4.
	t4 addInNeighbor: t3! !

!Graph methodsFor: 'adding'!
addEdgeFrom: t1 to: t2 label: t3
	| t4 t5 |
	t4 := self addNode: t1.
	t5 := self addNode: t2.
	t4 addNeighbor: t5 label: t3! !

!Graph methodsFor: 'adding'!
addEdges: t1
	| t3 |
	t1
		do: [:t2 |
			self addEdgeFrom: t2 key to: t2 value.
			self triggerEvent: #addEdge: with: t2.
			type = #(#undirected )
				ifTrue: [t3 := t2 value -> t2 key.
					self addEdgeFrom: t2 value to: t2 key.
					self triggerEvent: #addEdge: with: t3]]! !

!Graph methodsFor: 'adding'!
addNode: t1
	^ nodes
		at: t1
		ifAbsent: [self
				add: (self newNodeOn: t1).
			self
				triggerEvent: #addNode:
				with: (self getNode: t1).
			nodes at: t1]! !

!Graph methodsFor: 'accessing'!
anyNode
	^ self nodes anyOne! !

!Graph methodsFor: 'accessing'!
edges
	^ OrderedCollection
		accumulate: [:t1 | self edgesDo: t1]! !

!Graph methodsFor: 'accessing'!
getNode: t1
	^ self nodes at: t1! !

!Graph methodsFor: 'accessing'!
inspectNode: t1
	^ (self getNode: t1) inspect! !

!Graph methodsFor: 'accessing'!
nodes
	^ nodes! !

!Graph methodsFor: 'accessing'!
numberOfEdges
	^ (Iterator on: self msg: #edgesDo:) size! !

!Graph methodsFor: 'accessing'!
order
	^ nodes size! !

!Graph methodsFor: 'accessing'!
random
	^ random! !

!Graph methodsFor: 'accessing'!
random: t1
	random := t1! !

!Graph methodsFor: 'accessing'!
size
	^ nodes size! !

!Graph methodsFor: 'accessing'!
type
	^ type! !

!Graph methodsFor: 'initialization'!
arity: t1
	type := #(#arity ).
	nodeCreator := (InitializationBlocks at: #arity)
				value: t1! !

!Graph methodsFor: 'initialization'!
arityLabelled: t1
	type := #(#arity #labelled ).
	nodeCreator := (InitializationBlocks at: #arityLabelled)
				value: t1! !

!Graph methodsFor: 'initialization'!
binary
	type := #(#binary ).
	nodeCreator := InitializationBlocks at: #binary! !

!Graph methodsFor: 'initialization'!
binaryLabelled
	type := #(#binary #labelled ).
	nodeCreator := InitializationBlocks at: #binaryLabelled! !

!Graph methodsFor: 'initialization'!
directed
	type := #(#directed ).
	nodeCreator := InitializationBlocks at: #directed! !

!Graph methodsFor: 'initialization'!
implicitCollection: t1
	type := #(#implicitCollection ).
	nodeCreator := (InitializationBlocks at: #implicitCollection)
				value: self
				value: t1! !

!Graph methodsFor: 'initialization'!
implicitIteratorBlock: t1
	type := #(#implicitIteratorBlock ).
	nodeCreator := (InitializationBlocks at: #implicitIteratorBlock)
				value: self
				value: t1! !

!Graph methodsFor: 'initialization'!
initialize
	nodes := KeyedSet new.
	random := Random new! !

!Graph methodsFor: 'initialization'!
ordered
	type := #(#ordered ).
	nodeCreator := InitializationBlocks at: #ordered! !

!Graph methodsFor: 'initialization'!
orderedLabelled
	type := #(#ordered #labelled ).
	nodeCreator := InitializationBlocks at: #orderedLabelled! !

!Graph methodsFor: 'initialization'!
undirected
	type := #(#undirected ).
	nodeCreator := InitializationBlocks at: #undirected! !

!Graph methodsFor: 'initialization'!
unordered
	type := #(#unordered ).
	nodeCreator := InitializationBlocks at: #unordered! !

!Graph methodsFor: 'initialization'!
unorderedLabelled
	type := #(#unordered #labelled ).
	nodeCreator := InitializationBlocks at: #unorderedLabelled! !

!Graph methodsFor: 'converting'!
asMatrix
	| t1 |
	t1 := Matrix zeros: self order.
	self
		edgesDo: [:t2 | t1
				at: t2 key value
				at: t2 value value
				put: 1].
	^ t1! !

!Graph methodsFor: 'converting'!
asMatrixMapleFile
	| t1 t2 |
	t1 := self asMatrix.
	t2 := CrLfFileStream newFileNamed: 'matrix.mpl'.
	t2 ascii.
	t2 nextPutAll: 'A := Matrix(['.
	1
		to: t1 rowCount
		do: [:t3 |
			t2 nextPut: $[.
			1
				to: t1 columnCount
				do: [:t4 |
					t2 nextPutAll: (t1 at: t3 at: t4) asString.
					t4 < t1 columnCount
						ifTrue: [t2 nextPut: $,]].
			t2 nextPut: $].
			t3 < t1 rowCount 				ifTrue: [t2 nextPut: $,]]. 	t2 nextPutAll: ']);'. 	t2 close! ! !Graph methodsFor: 'converting'! asUndirected 	self 		edgesDo: [:t1 | self addEdgeFrom: t1 value to: t1 key]! ! !Graph methodsFor: 'graph operations'! averageDegree 	| t1 | 	t1 := self nodes 				detectSum: [:t2 | t2 degree]. 	^ t1 / self size! ! !Graph methodsFor: 'graph operations'! averagePathLength 	| t1 t2 t3 t4 | 	self flag: #bug. 	t1 := 0. 	t2 := 2. 	t4 := (self order * (self order - 1) / 2) asFloat. 	t3 := ProgressMorph label: 'Average path length progress'. 	t3 submorphs first color: Color paleGreen lighter lighter lighter. 	t3 submorphs first borderWidth: 1. 	t3 openInWorld. 	self 		nodesDo: [:t5 |  			t2 				to: self order 				do: [:t6 | t1 := t1 								+ (self 										breadthFirstPathFrom: t5 										to: (self getNode: t6))]. 			t2 := t2 + 1. 			t3 incrDone: self order - t2 / t4]. 	t3 delete. 	^ (t1 / t4) asFloat! ! !Graph methodsFor: 'graph operations'! averagePathLength2 	| t1 t2 t3 | 	t1 := 0. 	t2 := 2. 	t3 := (self order * (self order - 1) / 2) asFloat. 	self 		nodesDo: [:t4 |  			t2 				to: self order 				do: [:t5 | t1 := t1 								+ (self 										breadthFirstPathFrom: t4 										to: (self getNode: t5))]. 			t2 := t2 + 1]. 	^ (t1 / t3) asFloat! ! !Graph methodsFor: 'graph operations'! averagePathLengthAcuteAt 	| t1 t2 t3 t4 t5 t6 | 	t1 := 0. 	t2 := 2. 	t5 := 0. 	t3 := ProgressMorph label: 'Average path length progress'. 	t3 submorphs first color: Color paleGreen lighter lighter lighter. 	t3 submorphs first borderWidth: 1. 	t3 openInWorld. 	t6 := OrderedCollection new. 	(0.1 * self order) rounded 		timesRepeat: [t6 				add: (self nodes atRandom: self random)]. 	t4 := 1 / t6 size. 	t6 		do: [:t7 |  			t2 				to: t6 size 				do: [:t8 |  					t5 := t5 + 1. 					t1 := t1 								+ (self 										breadthFirstPathFrom: t7 										to: (self getNode: t8))]. 			t2 := t2 + 1. 			t3 incrDone: t4]. 	t3 delete. 	^ (t1 / t5) asFloat! ! !Graph methodsFor: 'graph operations'! averagePathLengthAcuteAt: t1  	| t2 t3 t4 t5 t6 t7 | 	t2 := 0. 	t3 := 2. 	t6 := (self order * (self order - 1) / 2) asFloat. 	t7 := OrderedCollection new. 	t1 * self order 		timesRepeat: [t7 				add: (self nodes atRandom: self random)]. 	t7 		do: [:t8 |  			t3 				to: t7 size 				do: [:t9 | t2 := t2 								+ (self 										breadthFirstPathFrom: t8 										to: (self getNode: t9))]. 			t3 := t3 + 1]. 	^ (t2 / t6) asFloat! ! !Graph methodsFor: 'graph operations'! breadthFirstPath2From: t1 to: t2 with: t3  	| t4 t5 t6 | 	t6 := Dictionary new. 	t6 at: t1 value put: 0. 	t4 := OrderedCollection with: t1. 	t3 add: t1. 	[t4 isEmpty] 		whileFalse: [t5 := t4 removeFirst. 			t5 outNeighbors 				do: [:t7 | (t3 includes: t7) 						ifFalse: [t4 addLast: t7. 							t3 add: t7. 							t6 at: t7 value put: (t6 at: t5 value) 									+ 1. 							t7 = t2 								ifTrue: [^ t6 at: t7 value]. 							nil]]]. 	^ 0! ! !Graph methodsFor: 'graph operations'! breadthFirstPathFrom: t1 to: t2  	| t3 | 	(t1 isLeaf 			or: [t2 isLeaf]) 		ifTrue: [^ 0]. 	t3 := Set new. 	^ self 		breadthFirstPath2From: t1 		to: t2 		with: t3! ! !Graph methodsFor: 'graph operations'! breadthFirstPathFrom: t1 to: t2 with: t3  	| t4 t5 t6 | 	t6 := Bag new. 	t4 := OrderedCollection with: t1. 	t3 add: t1. 	[t4 isEmpty] 		whileFalse: [t5 := t4 removeFirst. 			t5 outNeighbors 				do: [:t7 | (t3 includes: t7) 						ifFalse: [t4 addLast: t7. 							t3 add: t7. 							t6 add: t7 withOccurrences: (t6 occurrencesOf: t5) 									+ 1. 							t7 = t2 								ifTrue: [^ t6 occurrencesOf: t7]. 							nil]]]. 	^ 0! ! !Graph methodsFor: 'graph operations'! closed 	self 		edgesDo: [:t1 |  			self addEdge: t1 value -> t1 key.
			self addEdge: t1 key -> t1 value]! !

!Graph methodsFor: 'graph operations'!
clusteringCoefficient
	| t1 |
	t1 := 0.
	self
		nodesDo: [:t2 | t2 degree > 1
				ifTrue: [t1 := t1 + t2 clusteringCoefficient]].
	^ (t1 / self order) asFloat! !

!Graph methodsFor: 'graph operations'!
components
	^ Set
		accumulate: [:t1 | self componentsDo: t1]! !

!Graph methodsFor: 'graph operations'!
componentsDo: t1
	| t2 t3 t4 |
	t3 := self asSet.
	[t3 isEmpty]
		whileFalse: [t4 := t3 anyOne.
			t2 := self copyEmpty.
			t4
				markDo: [:t5 |
					t2 add: t5.
					t3
						remove: t5
						ifAbsent: []].
			t1 value: t2]! !

!Graph methodsFor: 'graph operations'!
degreeDistribution
	| t1 |
	t1 := Bag new: self size.
	self nodes
		do: [:t2 | t1 add: t2 degree].
	^ t1 frequencyDistribution! !

!Graph methodsFor: 'graph operations'!
distanceFrom: t1 to: t2
	^ (self shortestPathFrom: t1 to: t2) size! !

!Graph methodsFor: 'graph operations'!
reflexive
	self
		nodesDo: [:t1 | self addEdgeFrom: t1 to: t1]! !

!Graph methodsFor: 'graph operations'!
shortestPathFrom: t1 to: t2
	^ Dijkstra new graph: self source: t1;
		 shortestPathTo: t2! !

!Graph methodsFor: 'graph operations'!
symmetric
	| t1 |
	t1 := self copy.
	self
		edgesDo: [:t2 | t1 addEdge: t2 value -> t2 key].
	^ t1! !

!Graph methodsFor: 'graph operations'!
transposed
	| t1 |
	t1 := self copyEmpty.
	self
		edgesDo: [:t2 | t1 addEdge: t2 value -> t2 key].
	^ t1! !

!Graph methodsFor: 'removing'!
clear
	nodes := nil! !

!Graph methodsFor: 'removing'!
remove: t1
	^ self
		remove: t1
		ifAbsent: [self notFoundError]! !

!Graph methodsFor: 'removing'!
remove: t1 ifAbsent: t2
	^ nodes remove: t1 ifAbsent: t2! !

!Graph methodsFor: 'removing'!
removeEdge: t1
	| t2 |
	self
		removeEdge: t1
		ifAbsent: [self notFoundError].
	self triggerEvent: #removeEdge: with: t1.
	type = #(#undirected )
		ifTrue: [t2 := t1 value -> t1 key.
			self
				removeEdge: t2
				ifAbsent: [self notFoundError].
			self triggerEvent: #removeEdge: with: t2]! !

!Graph methodsFor: 'removing'!
removeEdge: t1 ifAbsent: t2
	^ self
		removeEdgeFrom: t1 key
		to: t1 value
		ifAbsent: t2! !

!Graph methodsFor: 'removing'!
removeEdgeFrom: t1 to: t2
	^ self
		removeEdgeFrom: t1
		to: t2
		ifAbsent: [self notFoundError]! !

!Graph methodsFor: 'removing'!
removeEdgeFrom: t1 to: t2 ifAbsent: t3
	^ self
		removeEdgeFromNode: (self nodeFor: t1)
		toNode: (self nodeFor: t2)
		ifAbsent: t3! !

!Graph methodsFor: 'copying'!
copyEmpty
	^ self isImplicit
		ifTrue: [self class ordered]
		ifFalse: [self copy initialize]! !

!Graph methodsFor: 'copying'!
copyNodes: t1
	^ self copyNodes: t1 labels: nil! !

!Graph methodsFor: 'copying'!
copyNodes: t1 labels: t2
	| t3 t4 |
	t3 := self copyEmpty.
	t4 := DictionaryWithDefault newWithDefaultValueBlock: t1.
	self
		do: [:t5 | t5
				neighborsAndLabelsDo: [:t6 :t7 | (t2 notNil
							and: [t7 notNil])
						ifTrue: [t3
								addEdgeFrom: (t4 at: t5 value)
								to: (t4 at: t6 value)
								label: (t2 value: t7)]
						ifFalse: [t3
								addEdgeFrom: (t4 at: t5 value)
								to: (t4 at: t6 value)]]].
	^ t3! !

!Graph methodsFor: 'dependency'!
dependencyOf: t1
	| t2 |
	t2 := self
				implicitCollection: [:t3 | t3 ~= ProtoObject
						ifTrue: [t3 superclass asArray]
						ifFalse: [#()]].
	t2 addNode: t1.
	^ t2! !

!Graph methodsFor: 'dependency'!
dependencyOf: t1 and: t2
	| t3 |
	t3 := self
				implicitCollection: [:t4 | t4 ~= ProtoObject
						ifTrue: [t4 superclass asArray]
						ifFalse: [#()]].
	t3 addNode: t1.
	t3 addNode: t2.
	^ t3! !

!Graph methodsFor: 'enumerating'!
do: t1
	self nodesDo: t1! !

!Graph methodsFor: 'enumerating'!
edgesDo: t1
	self
		nodesDo: [:t2 | t2
				neighborsDo: [:t3 | t1 value: t2 -> t3]]! !

!Graph methodsFor: 'enumerating'!
nodesDo: t1
	self type = #(#implicitCollection ) | (self type = #(#implicitIteratorBlock ))
		ifTrue: [nodes asOrderedCollection do: t1]
		ifFalse: [nodes do: t1]! !

!Graph methodsFor: 'enumerating'!
select: t1
	| t2 |
	t2 := Set new.
	self
		do: [:t3 | (t1 value: t3)
				ifTrue: [t2 add: t3]].
	^ t2! !

!Graph methodsFor: 'enumerating'!
valuesDo: t1
	nodes
		do: [:t2 | t1 value: t2 value]! !

!Graph methodsFor: 'testing'!
includes: t1
	^ nodes includes: t1! !

!Graph methodsFor: 'testing'!
isAChain
	^ (self
		select: [:t1 | t1 isAnExtremity]) size + (self
			select: [:t1 | t1 isMiddle]) size = self order! !

!Graph methodsFor: 'testing'!
isEmpty
	^ nodes isEmpty! !

!Graph methodsFor: 'testing'!
occurrencesOf: t1
	^ (self includes: t1)
		ifTrue: [1]
		ifFalse: [0]! !

!Graph methodsFor: 'private'!
isImplicit
	^ (type includes: #implicitCollection)
		or: [type includes: #implicitIteratorBlock]! !

!Graph methodsFor: 'private'!
isLabelled
	^ type includes: #labelled! !

!Graph methodsFor: 'private'!
newNodeOn: t1
	^ nodeCreator value: t1! !

!Graph methodsFor: 'private'!
nodeCreator: t1
	nodeCreator := t1! !

!Graph methodsFor: 'private'!
nodeFor: t1
	^ nodes at: t1! !

!Graph methodsFor: 'private'!
removeEdgeFromNode: t1 toNode: t2 ifAbsent: t3
	(t1 hasEdgeTo: t2)
		ifTrue: [t1 removeNeighbor: t2.
			t2 removeInNeighbor: t1.
			^ self].
	^ t3 value! !

!Graph methodsFor: 'errors'!
notFoundError
	^ self error: 'object is not in the collection'! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

Graph class
	instanceVariableNames: ''!

!Graph class methodsFor: 'instance creation'!
arity: t1
	^ super new initialize arity: t1! !

!Graph class methodsFor: 'instance creation'!
arityLabelled: t1
	^ super new initialize arityLabelled: t1! !

!Graph class methodsFor: 'instance creation'!
binary
	^ super new initialize binary! !

!Graph class methodsFor: 'instance creation'!
binaryLabelled
	^ super new initialize binaryLabelled! !

!Graph class methodsFor: 'instance creation'!
directed
	^ super new initialize directed! !

!Graph class methodsFor: 'instance creation'!
implicitCollection: t1
	^ super new initialize implicitCollection: t1! !

!Graph class methodsFor: 'instance creation'!
implicitIteratorBlock: t1
	^ super new initialize implicitIteratorBlock: t1! !

!Graph class methodsFor: 'instance creation'!
ordered
	^ super new initialize ordered! !

!Graph class methodsFor: 'instance creation'!
orderedLabelled
	^ super new initialize orderedLabelled! !

!Graph class methodsFor: 'instance creation'!
undirected
	^ super new initialize undirected! !

!Graph class methodsFor: 'instance creation'!
unordered
	^ super new initialize unordered! !

!Graph class methodsFor: 'instance creation'!
unorderedLabelled
	^ super new initialize unorderedLabelled! !

!Graph class methodsFor: 'examples'!
dependencyInCategory
	^ self
		dependencyInCategory: (FillInTheBlank request: 'Display the graph of dependency of the category :')! !

!Graph class methodsFor: 'examples'!
dependencyInCategory: t1
	| t2 |
	t2 := self
				implicitCollection: [:t3 | t3 ~= ProtoObject
						ifTrue: [t3 superclass asArray]
						ifFalse: [#()]].
	(Smalltalk organization listAtCategoryNamed: t1)
		do: [:t3 | t2 addNode: t3 sunitAsClass].
	^ t2! !

!Graph class methodsFor: 'examples'!
dependencyInPackage
	^ self
		dependencyInPackage: (FillInTheBlank request: 'Display the graph of dependency of the package :')! !

!Graph class methodsFor: 'examples'!
dependencyInPackage: t1
	| t2 |
	t2 := self
				implicitCollection: [:t3 | t3 ~= ProtoObject
						ifTrue: [t3 superclass asArray]
						ifFalse: [#()]].
	(SystemOrganization categories
		select: [:t4 | t4 asString includesSubString: t1])
		do: [:t5 | (SystemOrganization listAtCategoryNamed: t5)
				collect: [:t6 | t2 addNode: t6 sunitAsClass]].
	^ t2! !

!Graph class methodsFor: 'examples'!
empty
	| t1 |
	t1 := self unordered.
	^ t1! !

!Graph class methodsFor: 'examples'!
exampleBinaryTree: t1
	^ self
		tree: t1
		arity: 2
		graphType: #undirected! !

!Graph class methodsFor: 'examples'!
exampleDependencyInCategory
	^ self dependencyInCategory! !

!Graph class methodsFor: 'examples'!
exampleDependencyInPackage
	^ self dependencyInPackage! !

!Graph class methodsFor: 'examples'!
exampleDirectedGraph
	| t1 |
	t1 := self ordered.
	t1 addEdge: 1 -> 2.
	t1 addEdge: 2 -> 1.
	t1 addEdge: 1 -> 3.
	t1 reflexive.
	^ t1! !

!Graph class methodsFor: 'examples'!
exampleGraph
	| t1 |
	t1 := self ordered.
	t1 addEdges: {#r1 -> #n1. #r1 -> #n2. #r2 -> #n2. #n1 -> #n3. #n2 -> #n3. #n3 -> #r1}.
	^ t1! !

!Graph class methodsFor: 'examples'!
exampleGraph2
	| t1 |
	t1 := self unordered.
	t1 addEdge: #a -> #b.
	^ t1! !

!Graph class methodsFor: 'examples'!
exampleGraph3
	| t1 |
	t1 := self undirected.
	t1 addEdge: #r1 -> #n1.
	t1 addEdge: #r1 -> #n2.
	t1 addEdge: #r2 -> #n2.
	t1 addEdge: #n1 -> #n3.
	t1 addEdge: #n2 -> #n3.
	t1 addEdge: #n3 -> #r1.
	^ t1! !

!Graph class methodsFor: 'examples'!
exampleImplicitGraph
	| t1 |
	t1 := self
				implicitCollection: [:t2 | t2 subclasses].
	Graph withAllSubclasses
		do: [:t2 | t2 subclasses = #()
				ifFalse: [t1 addNode: t2]].
	^ t1! !

!Graph class methodsFor: 'examples'!
exampleImplicitGraph2
	| t1 |
	t1 := self
				implicitIteratorBlock: [:t2 | [:t3 | t2 subclasses do: t3]].
	Graph withAllSubclasses
		do: [:t2 | t2 subclasses = #()
				ifFalse: [t1 addNode: t2]].
	^ t1! !

!Graph class methodsFor: 'examples'!
exampleImplicitGraph3
	| t1 |
	t1 := self
				implicitIteratorBlock: [:t2 | [:t3 | t2 subclasses do: t3]].
	Graph withAllSuperclasses
		do: [:t2 | t1 addNode: t2].
	^ t1! !

!Graph class methodsFor: 'examples'!
exampleImplicitGraph4
	| t1 |
	t1 := self
				implicitCollection: [:t2 | t2 ~= ProtoObject
						ifTrue: [t2 superclass asArray]
						ifFalse: [#()]].
	(Smalltalk organization listAtCategoryNamed: 'Collections-Graphs')
		do: [:t2 | t1 addNode: t2 sunitAsClass].
	^ t1! !

!Graph class methodsFor: 'examples'!
exampleImplicitGraph5
	| t1 |
	t1 := self
				implicitCollection: [:t2 | t2 ~= ProtoObject
						ifTrue: [t2 superclass asArray]
						ifFalse: [#()]].
	t1 addNode: ExplicitGraphNode.
	t1 addNode: Graph.
	t1 inspect.
	^ t1! !

!Graph class methodsFor: 'examples'!
exampleLatticeOfSize: t1
	^ self exampleLatticeWidth: t1 height: t1! !

!Graph class methodsFor: 'examples'!
exampleLatticeWidth: t1 height: t2
	^ self
		latticeWidth: t1
		height: t2
		graphType: #undirected! !

!Graph class methodsFor: 'examples'!
exampleLine: t1
	^ self line: t1 graphType: #undirected! !

!Graph class methodsFor: 'examples'!
exampleRandomGraphWithOrder: t1 probability: t2
	| t3 |
	t3 := self undirected.
	self initGraph: t3 withOrder: 1.
	self
		graph: t3
		randomGraphWithOrder: t1
		probability: t2.
	^ t3! !

!Graph class methodsFor: 'examples'!
exampleRing: t1
	^ self ring: t1 graphType: #undirected! !

!Graph class methodsFor: 'examples'!
exampleScaleFreeGraphWithOrder: t1 startingWith: t2
	| t3 |
	t3 := self undirected.
	self initGraph: t3 withOrder: t2.
	self graph: t3 addScaleFreeNodes: t1.
	^ t3! !

!Graph class methodsFor: 'examples'!
exampleTree: t1 arity: t2
	^ self
		tree: t1
		arity: t2
		graphType: #undirected! !

!Graph class methodsFor: 'examples'!
exampleUndirectedGraph
	| t1 |
	t1 := self undirected.
	t1 addEdge: 1 -> 2.
	t1 addEdge: 1 -> 3.
	t1 addEdge: 2 -> 3.
	t1 addEdge: 3 -> 4.
	^ t1! !

!Graph class methodsFor: 'examples'!
fixtureChainWithExtremity
	| t1 |
	t1 := self directed.
	t1 addEdge: 1 -> 2.
	t1 addEdge: 2 -> 1.
	t1 addEdge: 2 -> 3.
	t1 addEdge: 3 -> 4.
	t1 addEdge: 4 -> 5.
	t1 addEdge: 5 -> 6.
	t1 addEdge: 6 -> 5.
	^ t1! !

!Graph class methodsFor: 'examples'!
latticeOfSize: t1
	| t2 |
	t2 := self undirected.
	^ self graph: t2 latticeOfSize: t1! !

!Graph class methodsFor: 'graph rules'!
graph: t1 addRandomEdgesWithProbability: t2
	| t3 |
	t3 := 2.
	t1
		nodesDo: [:t4 |
			t3
				to: t1 size
				do: [:t5 | t1 random next < t2 						ifTrue: [t1 addEdge: t4 value -> t5]].
			t3 := t3 + 1]! !

!Graph class methodsFor: 'graph rules'!
graph: t1 addRandomNodes: t2 withProbability: t3
	| t4 |
	t4 := t1 order + 1.
	t1
		nodesDo: [:t5 |
			t4
				to: t1 size
				do: [:t6 | t1 random next < t3 						ifTrue: [t1 addEdge: t5 value -> t6]].
			t4 := t4 + 1]! !

!Graph class methodsFor: 'graph rules'!
graph: t1 addScaleFreeNodes: t2
	| t3 t5 t6 t7 t8 |
	t3 := t1 order.
	t3 + 1
		to: t2
		do: [:t4 |
			t5 := t1 random nextInt: t3.
			t6 := 0.
			t7 := Set new: t5.
			[t6 = t5]
				whileFalse: [t8 := self rouletteWheelWith: t1.
					(t7 includes: t8)
						ifFalse: [t7 add: t8.
							t6 := t6 + 1]].
			t7
				do: [:t9 | t1 addEdge: t4 -> t9]]! !

!Graph class methodsFor: 'graph rules'!
graph: t1 addScaleFreeNodes: t2 withNewEdges: t3
	| t5 t6 t7 |
	t3 + 1
		to: t2
		do: [:t4 |
			t5 := 0.
			t6 := Set new: t3.
			[t5 = t3]
				whileFalse: [t7 := self rouletteWheelWith: t1.
					(t6 includes: t7)
						ifFalse: [t6 add: t7.
							t5 := t5 + 1]].
			t6
				do: [:t8 | t1 addEdge: t4 -> t8]]! !

!Graph class methodsFor: 'graph topology'!
graph: t1 randomGraphWithOrder: t2 probability: t3
	self initGraph: t1 withOrder: t2.
	self graph: t1 addRandomEdgesWithProbability: t3.
	^ t1! !

!Graph class methodsFor: 'graph topology'!
graph: t1 scaleFreeGraphWithOrder: t2 startingWith: t3
	self initGraph: t1 withOrder: t3.
	self
		graph: t1
		addScaleFreeNodes: t2
		withNewEdges: t3.
	^ t1! !

!Graph class methodsFor: 'graph topology'!
latticeWidth: t1 height: t2 graphType: t3
	^ self
		latticeWidth: t1
		height: t2
		graphType: t3
		with: nil! !

!Graph class methodsFor: 'graph topology'!
latticeWidth: t1 height: t2 graphType: t3 with: t4
	| t5 t9 |
	t4
		ifNil: [t5 := self perform: t3]
		ifNotNil: [t5 := self perform: t3 with: t4].
	t9 := t2 - 1.
	1
		to: t9
		do: [:t6 |
			1
				to: t1 - 1
				do: [:t7 |
					t5 addEdge: t6 - 1 * t1 + t7 -> (t6 - 1 * t1 + t7 + 1).
					t5 addEdge: t6 - 1 * t1 + t7 -> (t6 * t1 + t7)].
			t5 addEdge: t6 * t1 -> (t6 + 1 * t1)].
	t9 := t1 - 1.
	1
		to: t9
		do: [:t6 | t5 addEdge: t1 * (t2 - 1) + t6 -> (t1 * (t2 - 1) + t6 + 1)].
	^ t5! !

!Graph class methodsFor: 'graph topology'!
line: t1 graphType: t2
	^ self
		line: t1
		graphType: t2
		with: nil! !

!Graph class methodsFor: 'graph topology'!
line: t1 graphType: t2 with: t3
	| t4 |
	t3
		ifNil: [t4 := self perform: t2]
		ifNotNil: [t4 := self perform: t2 with: t3].
	1
		to: t1 - 1
		do: [:t5 | t4 addEdge: t5 -> (t5 + 1)].
	^ t4! !

!Graph class methodsFor: 'graph topology'!
ring: t1 graphType: t2
	^ self
		ring: t1
		graphType: t2
		with: nil! !

!Graph class methodsFor: 'graph topology'!
ring: t1 graphType: t2 with: t3
	| t4 |
	t3
		ifNil: [t4 := self perform: t2]
		ifNotNil: [t4 := self perform: t2 with: t3].
	1
		to: t1 - 1
		do: [:t5 | t4 addEdge: t5 -> (t5 + 1)].
	t4 addEdge: t1 -> 1.
	^ t4! !

!Graph class methodsFor: 'graph topology'!
rouletteWheelWith: t1
	| t2 t3 |
	t2 := t1 nodes
				detectSum: [:t4 | t4 degree + 1].
	t3 := t1 random next * t2.
	t2 := 0.
	t1
		nodesDo: [:t4 |
			t2 := t2 + t4 degree + 1.
			t2 > t3
				ifTrue: [^ t4].
			nil].
	self error: 'No node found'! !

!Graph class methodsFor: 'graph topology'!
tree: t1 arity: t2 graphType: t3
	^ self
		tree: t1
		arity: t2
		graphType: t3
		with: nil! !

!Graph class methodsFor: 'graph topology'!
tree: t1 arity: t2 graphType: t3 with: t4
	| t5 t6 t7 |
	t4
		ifNil: [t7 := self perform: t3]
		ifNotNil: [t7 := self perform: t3 with: t4].
	t5 := (t2 raisedToInteger: t1)
				- 1 / (t2 - 1).
	t6 := 2.
	1
		to: t5
				- (t2 raisedToInteger: t1 - 1)
		do: [:t8 | 0
				to: t2 - 1
				do: [:t9 |
					t7 addEdge: t8 -> t6.
					t6 := t6 + 1]].
	^ t7! !

!Graph class methodsFor: 'graph bases'!
initGraph: t1 withOrder: t2
	1
		to: t2
		do: [:t3 | t1 addNode: t3]! !

!Graph class methodsFor: 'initialization'!
initialize
	| t1 t8 |
	t1 := Dictionary new.
	t1
		at: #binary
		put: [:t2 | ExplicitGraphNode binary: t2].
	t1
		at: #arity
		put: [:t3 | [:t2 | ExplicitGraphNode on: t2 arity: t3]].
	t1
		at: #binaryLabelled
		put: [:t2 | LabelledExplicitGraphNode binary: t2].
	t1
		at: #ordered
		put: [:t2 | ExplicitGraphNode ordered: t2].
	t1
		at: #unordered
		put: [:t2 | ExplicitGraphNode newOn: t2].
	t1
		at: #directed
		put: [:t2 | ExplicitGraphNode newOn: t2].
	t1
		at: #undirected
		put: [:t2 | ExplicitGraphNode newOn: t2].
	t1
		at: #arityLabelled
		put: [:t3 | [:t2 | LabelledExplicitGraphNode on: t2 arity: t3]].
	t1
		at: #orderedLabelled
		put: [:t2 | LabelledExplicitGraphNode ordered: t2].
	t1
		at: #unorderedLabelled
		put: [:t2 | LabelledExplicitGraphNode newOn: t2].
	t1
		at: #implicitCollection
		put: [:t4 :t5 | [:t2 | ImplicitGraphNode
				on: t2
				collectionBlock: [(t5 value: t2)
						collect: [:t6 | t4 addNode: t6]]]].
	t1
		at: #implicitIteratorBlock
		put: [:t4 :t7 | [:t2 |
			t8 := t7 value: t2.
			ImplicitGraphNode
				on: t2
				iteratorBlock: [:t9 | t8
						value: [:t6 | t9
								value: (t4 addNode: t6)]]]].
	InitializationBlocks := t1! !

!Graph class methodsFor: 'private'!
new
	^ super new! !

PackageInfo subclass: #GraphInfo
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphs-Collections-Graphs'!

!GraphInfo methodsFor: 'as yet unclassified'!
methodCategoryPrefix
	^ '*collections-graphs'! !

!GraphInfo methodsFor: 'as yet unclassified'!
prerequisiteChangeSets
	^ #('Collections-Misc' 'Iterator' )! !

GraphNode subclass: #ImplicitGraphNode
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphs-Collections-Graphs'!

!ImplicitGraphNode methodsFor: 'accessing edges'!
neighborsDo: t1
	self outNeighbors do: t1! !

!ImplicitGraphNode methodsFor: 'accessing edges'!
outNeighbors
	^ OrderedCollection
		accumulate: [:t1 | self neighborsDo: t1]! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

ImplicitGraphNode class
	instanceVariableNames: ''!

!ImplicitGraphNode class methodsFor: 'instance creation'!
on: t1 collectionBlock: t2
	^ ImplicitGraphNodeCollection on: t1 collectionBlock: t2! !

!ImplicitGraphNode class methodsFor: 'instance creation'!
on: t1 iterator: t2
	^ ImplicitGraphNodeIterator on: t1 iterator: t2! !

!ImplicitGraphNode class methodsFor: 'instance creation'!
on: t1 iteratorBlock: t2
	^ ImplicitGraphNodeIterator on: t1 iteratorBlock: t2! !

ImplicitGraphNode subclass: #ImplicitGraphNodeCollection
	instanceVariableNames: 'collectionBlock'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphs-Collections-Graphs'!

!ImplicitGraphNodeCollection methodsFor: 'initialisation'!
collectionBlock: t1
	collectionBlock := t1 fixTemps! !

!ImplicitGraphNodeCollection methodsFor: 'accessing edges'!
degree
	^ self outNeighbors size! !

!ImplicitGraphNodeCollection methodsFor: 'accessing edges'!
outNeighbors
	^ collectionBlock value! !

!ImplicitGraphNodeCollection methodsFor: 'testing edges'!
hasEdgeTo: t1
	^ self outNeighbors includes: t1! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

ImplicitGraphNodeCollection class
	instanceVariableNames: ''!

!ImplicitGraphNodeCollection class methodsFor: 'instance creation'!
on: t1 collectionBlock: t2
	^ self new value: t1;
		 collectionBlock: t2! !

ImplicitGraphNode subclass: #ImplicitGraphNodeIterator
	instanceVariableNames: 'iterator'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphs-Collections-Graphs'!

!ImplicitGraphNodeIterator methodsFor: 'accessing edges'!
degree
	^ iterator size! !

!ImplicitGraphNodeIterator methodsFor: 'accessing edges'!
neighborsDo: t1
	iterator do: t1! !

!ImplicitGraphNodeIterator methodsFor: 'testing edges'!
hasEdgeTo: t1
	^ iterator includes: t1! !

!ImplicitGraphNodeIterator methodsFor: 'initialisation'!
iterator: t1
	iterator := t1 fixTemps! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

ImplicitGraphNodeIterator class
	instanceVariableNames: ''!

!ImplicitGraphNodeIterator class methodsFor: 'instance creation'!
on: t1 iterator: t2
	^ self new value: t1;
		 iterator: t2! !

!ImplicitGraphNodeIterator class methodsFor: 'instance creation'!
on: t1 iteratorBlock: t2
	^ self
		on: t1
		iterator: (Iterator on: t2)! !

Graph subclass: #RootedGraph
	instanceVariableNames: 'roots'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphs-Collections-Graphs'!

!RootedGraph methodsFor: 'adding'!
addEdgeFrom: t1 to: t2
	super addEdgeFrom: t1 to: t2.
	(roots includes: t2)
		ifTrue: [roots
				remove: t2
				ifAbsent: []]! !

!RootedGraph methodsFor: 'adding'!
addEdgeFrom: t1 to: t2 label: t3
	super
		addEdgeFrom: t1
		to: t2
		label: t3.
	(roots includes: t2)
		ifTrue: [roots
				remove: t2
				ifAbsent: []]! !

!RootedGraph methodsFor: 'adding'!
addRoot: t1
	roots add: t1.
	^ nodes
		add: (self newNodeOn: t1)! !

!RootedGraph methodsFor: 'adding'!
buildFromRoots: t1
	self roots: t1.
	self
		markDo: [:t2 | t2]! !

!RootedGraph methodsFor: 'adding'!
roots: t1 children: t2
	^ self
		roots: t1
		childrenGenerator: [:t3 | [:t4 | (t2 value: t3)
				do: t4]]! !

!RootedGraph methodsFor: 'adding'!
roots: t1 children: t2 label: t3
	^ self
		roots: t1
		childrenGenerator: [:t4 | [:t5 | (t2 value: t4)
				do: t5]]
		label: t3! !

!RootedGraph methodsFor: 'adding'!
roots: t1 childrenGenerator: t2
	^ self
		roots: t1
		childrenGenerator: t2
		label: nil! !

!RootedGraph methodsFor: 'adding'!
roots: t1 childrenGenerator: t2 label: t3
	| t4 t5 |
	self roots: t1.
	t4 := t1 asSet copy.
	[t4 isEmpty]
		whileFalse: [t5 := t4 anyOne.
			(t2 value: t5)
				value: [:t6 |
					(self includes: t6)
						ifFalse: [t4 add: t6].
					t3 isNil
						ifTrue: [self addEdgeFrom: t5 to: t6]
						ifFalse: [self
								addEdgeFrom: t5
								to: t6
								label: (t3 value: t5 value: t6)]].
			t4 remove: t5]! !

!RootedGraph methodsFor: 'adding'!
roots: t1 childrenLabelGenerator: t2
	| t3 t4 |
	self roots: t1.
	t3 := t1 asSet.
	[t3 isEmpty]
		whileFalse: [t4 := t3 anyOne.
			(t2 value: t4)
				value: [:t5 :t6 |
					(self includes: t5)
						ifFalse: [t3 add: t5].
					self
						addEdgeFrom: t4
						to: t5
						label: t6].
			t3 remove: t4]! !

!RootedGraph methodsFor: 'adding'!
roots: t1 childrenMsg: t2
	^ self
		roots: t1
		childrenGenerator: [:t3 | [:t4 | (t3 perform: t2)
				do: t4]]! !

!RootedGraph methodsFor: 'enumerating'!
breadthFirstDo: t1
	| t2 t3 |
	t2 := self frontier.
	[t3 := t2 frontier copy.
	t3 isEmpty]
		whileFalse: [t1 value: t3.
			t2 removeAll: t3]! !

!RootedGraph methodsFor: 'enumerating'!
frontier
	^ DAGFrontier frontierOn: self! !

!RootedGraph methodsFor: 'enumerating'!
markDo: t1
	| t2 t3 t4 |
	t2 := self rootNodes asSet.
	t3 := Set new.
	[t2 isEmpty]
		whileFalse: [t4 := t2 anyOne.
			t3 add: t4.
			t1 value: t4.
			t4
				neighborsDo: [:t5 | (t3 includes: t5)
						ifFalse: [t2 add: t5]].
			t2 remove: t4]! !

!RootedGraph methodsFor: 'enumerating'!
preOrderDo: t1
	| t2 t3 t5 |
	t2 := self rootNodes.
	t3 := Bag new.
	nodes
		do: [:t4 | t3 addAll: t4 outNeighbors].
	[t5 := t2
				anyIfNone: [^ self].
	t1 value: t5.
	t2 remove: t5.
	t5
		neighborsDo: [:t6 | (t3 removeOne: t6)
					= 0
				ifTrue: [t2 add: t6]]] repeat! !

!RootedGraph methodsFor: 'enumerating'!
walkPre: t1 post: t2
	self rootNodes
		do: [:t3 | t3 walkPre: t1 post: t2]! !

!RootedGraph methodsFor: 'copying'!
copyEmpty
	| t1 |
	t1 := super copyEmpty.
	t1
		roots: (roots copyEmpty: roots size).
	^ t1! !

!RootedGraph methodsFor: 'copying'!
copyNodes: t1 labels: t2
	| t3 t4 |
	t3 := self copyEmpty.
	t4 := DictionaryWithDefault newWithDefaultValueBlock: t1.
	t3
		roots: (roots
				collect: [:t5 | t4 at: t5]).
	self
		do: [:t6 | t6
				neighborsAndLabelsDo: [:t7 :t8 | (t2 notNil
							and: [t8 notNil])
						ifTrue: [t3
								addEdgeFrom: (t4 at: t6 value)
								to: (t4 at: t7 value)
								label: (t2 value: t8)]
						ifFalse: [t3
								addEdgeFrom: (t4 at: t6 value)
								to: (t4 at: t7 value)]]].
	^ t3! !

!RootedGraph methodsFor: 'graph operations'!
depthList
	^ OrderedCollection
		accumulate: [:t1 | self breadthFirstDo: t1]! !

!RootedGraph methodsFor: 'graph operations'!
reduce
	self rootNodes
		do: [:t1 | self reduceStep: t1 with: OrderedCollection new]! !

!RootedGraph methodsFor: 'graph operations'!
reduceSlow
	| t1 t4 t6 |
	t1 := Set
				accumulate: [:t2 | self rootNodes
						do: [:t3 | t2
								value: (Array with: t3)]].
	[t1 isEmpty]
		whileFalse: [t4 := Set new.
			t1
				do: [:t5 |
					t6 := t5 last.
					t6
						neighborsDo: [:t7 |
							t5
								do: [:t8 | (t8 ~= t6
											and: [t8 hasEdgeTo: t7])
										ifTrue: [self removeEdgeFrom: t8 to: t7]].
							t4
								add: (t5 copyWith: t7)]].
			t1 := t4]! !

!RootedGraph methodsFor: 'graph operations'!
reduceStep: t1 with: t2
	t1 degree = 0
		ifTrue: [^ self].
	t1 outNeighbors copy
		do: [:t3 |
			t2
				do: [:t4 | (t4 hasEdgeTo: t3)
						ifTrue: [self removeEdgeFrom: t4 to: t3]].
			t2 addLast: t1.
			self reduceStep: t3 with: t2.
			t2 removeLast]! !

!RootedGraph methodsFor: 'initialization'!
findRoots
	roots := Set new addAll: nodes;
				 yourself.
	self
		nodesDo: [:t1 | t1
				neighborsDo: [:t2 | roots
						remove: t2
						ifAbsent: []]]! !

!RootedGraph methodsFor: 'initialization'!
initialize
	super initialize.
	roots := Set new! !

!RootedGraph methodsFor: 'initialization'!
roots: t1
	roots := t1.
	roots
		do: [:t2 | self addNode: t2]! !

!RootedGraph methodsFor: 'testing'!
isCyclic
	| t1 t2 t4 |
	t1 := self rootNodes.
	t2 := Bag new.
	nodes
		do: [:t3 | t2 addAll: t3 outNeighbors].
	[t4 := t1
				anyIfNone: [^ t2 isEmpty not].
	t1 remove: t4.
	t4
		neighborsDo: [:t5 | (t2 removeOne: t5)
					= 0
				ifTrue: [t1 add: t5]]] repeat! !

!RootedGraph methodsFor: 'testing'!
isEmpty
	^ roots isEmpty! !

!RootedGraph methodsFor: 'testing'!
isTree
	| t1 |
	t1 := Set new.
	nodes
		do: [:t2 | t2
				neighborsDo: [:t3 |
					(t1 includes: t3)
						ifTrue: [^ false].
					t1 add: t3]].
	^ true! !

!RootedGraph methodsFor: 'removing'!
removeAllFrom: t1
	t1
		walkPre: [:t2 | t2]
		post: [:t3 | t3 == t1
				ifTrue: [t1 outNeighbors copy
						do: [:t4 | t1 removeNeighbor: t4]]
				ifFalse: [self remove: t3]]! !

!RootedGraph methodsFor: 'accessing'!
rootNode
	^ self nodeFor: roots anyOne! !

!RootedGraph methodsFor: 'accessing'!
rootNodes
	^ roots
		collect: [:t1 | self nodeFor: t1]! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

RootedGraph class
	instanceVariableNames: ''!

!RootedGraph class methodsFor: 'examples'!
exampleDAG
	| t1 |
	t1 := self unordered.
	t1 addRoot: #r1.
	t1 addRoot: #r2.
	t1 addEdge: #r1 -> #n1.
	t1 addEdge: #r1 -> #n2.
	t1 addEdge: #r2 -> #n2.
	t1 addEdge: #n1 -> #n3.
	t1 addEdge: #n2 -> #n3.
	^ t1! !

!RootedGraph class methodsFor: 'examples'!
exampleForest
	^ self unordered
		roots: (Set with: Number with: Stream)
		children: [:t1 | t1 subclasses]! !

!RootedGraph class methodsFor: 'examples'!
exampleImplicitLargeTree
	^ (self
		implicitCollection: [:t1 | t1 == Class
				ifTrue: [#()]
				ifFalse: [t1 subclasses
						asSortedCollection: [:t2 :t3 | t2 name < t3 name]]])
		buildFromRoots: (Array with: Object)! !

!RootedGraph class methodsFor: 'examples'!
exampleImplicitSmallTree
	^ (self
		implicitCollection: [:t1 | t1 subclasses])
		buildFromRoots: (Set with: Number)! !

!RootedGraph class methodsFor: 'examples'!
exampleLargeTree
	^ self ordered
		roots: (Array with: Object)
		children: [:t1 | t1 == Class
				ifTrue: [#()]
				ifFalse: [t1 subclasses
						asSortedCollection: [:t2 :t3 | t2 name < t3 name]]]! ! !RootedGraph class methodsFor: 'examples'! exampleMediumLabelledTree 	^ self unorderedLabelled 		roots: (Set with: Collection) 		children: [:t1 | t1 subclasses] 		label: [:t2 :t3 | t3 isVariable 				ifTrue: [t3 isBits 						ifTrue: [#variableByte] 						ifFalse: [#variable]] 				ifFalse: [#normal]]! ! !RootedGraph class methodsFor: 'examples'! exampleMediumTree 	^ self unordered 		roots: (Set with: Stream) 		children: [:t1 | t1 subclasses]! ! !RootedGraph class methodsFor: 'examples'! exampleMediumTree2 	^ self unordered 		roots: (Set with: Collection) 		children: [:t1 | t1 subclasses]! ! !RootedGraph class methodsFor: 'examples'! exampleSmallLabelledTree 	^ self unorderedLabelled 		roots: (Set with: Magnitude) 		children: [:t1 | t1 subclasses] 		label: [:t2 :t3 | t3 category]! ! !RootedGraph class methodsFor: 'examples'! exampleSmallLabelledTree2 	^ self unorderedLabelled 		roots: (Set with: Magnitude) 		children: [:t1 | t1 subclasses] 		label: [:t2 :t3 | t3 isVariable 				ifTrue: [t3 isBits 						ifTrue: [#variableByte] 						ifFalse: [#variable]] 				ifFalse: [#normal]]! ! !RootedGraph class methodsFor: 'examples'! exampleSmallTree 	^ self unordered 		roots: (Set with: Number) 		children: [:t1 | t1 subclasses]! ! !RootedGraph class methodsFor: 'examples'! exampleSmallTree2 	^ self unordered 		roots: (Set with: Magnitude) 		childrenMsg: #subclasses! !  GraphNode subclass: #ExplicitGraphNode 	instanceVariableNames: 'inNeighbors graph outNeighbors' 	classVariableNames: '' 	poolDictionaries: '' 	category: 'Graphs-Collections-Graphs'! !ExplicitGraphNode methodsFor: 'neighborhood'! addInNeighbor: t1  	(inNeighbors includes: t1) 		ifFalse: [inNeighbors add: t1]. 	^ t1! ! !ExplicitGraphNode methodsFor: 'neighborhood'! addNeighbor: t1  	(outNeighbors includes: t1) 		ifFalse: [outNeighbors add: t1. 			t1 addInNeighbor: self. 			self triggerEvent: #addNeighbor: with: t1]. 	^ t1! ! !ExplicitGraphNode methodsFor: 'neighborhood'! addNeighbor: t1 at: t2  	^ outNeighbors at: t2 put: t1! ! !ExplicitGraphNode methodsFor: 'neighborhood'! addOutNeighbor: t1  	(outNeighbors includes: t1) 		ifFalse: [outNeighbors add: t1. 			t1 addInNeighbor: self. 			self triggerEvent: #addNeighbor: with: t1]. 	^ t1! ! !ExplicitGraphNode methodsFor: 'neighborhood'! inNeighbors 	^ inNeighbors! ! !ExplicitGraphNode methodsFor: 'neighborhood'! neighbors 	^ outNeighbors union: inNeighbors! ! !ExplicitGraphNode methodsFor: 'neighborhood'! outNeighbors 	^ outNeighbors! ! !ExplicitGraphNode methodsFor: 'copying'! copy 	^ super copy setNeighbors: outNeighbors copy! ! !ExplicitGraphNode methodsFor: 'degree'! degree 	(outNeighbors includes: self) 		ifTrue: [^ outNeighbors size - 1]. 	^ outNeighbors size! ! !ExplicitGraphNode methodsFor: 'degree'! inDegree 	(inNeighbors includes: self) 		ifTrue: [^ inNeighbors size - 1]. 	^ inNeighbors size! ! !ExplicitGraphNode methodsFor: 'degree'! inOutDegree 	^ (Array new: 2) at: 1 put: self inDegree; 		 at: 2 put: self outDegree; 		 yourself! ! !ExplicitGraphNode methodsFor: 'degree'! outDegree 	(outNeighbors includes: self) 		ifTrue: [^ outNeighbors size - 1]. 	^ outNeighbors size! ! !ExplicitGraphNode methodsFor: 'accessing'! graph 	^ graph! ! !ExplicitGraphNode methodsFor: 'accessing'! graph: t1  	graph := t1! ! !ExplicitGraphNode methodsFor: 'accessing'! unclosedConnection 	^ outNeighbors symmetricDifference: inNeighbors! ! !ExplicitGraphNode methodsFor: 'accessing'! unclosedInNeighbors 	^ (outNeighbors symmetricDifference: inNeighbors) 		intersection: inNeighbors! ! !ExplicitGraphNode methodsFor: 'accessing'! unclosedNeighbors 	^ outNeighbors symmetricDifference: inNeighbors! ! !ExplicitGraphNode methodsFor: 'accessing'! unclosedOutNeighbors 	^ (outNeighbors symmetricDifference: inNeighbors) 		intersection: outNeighbors! ! !ExplicitGraphNode methodsFor: 'testing edges'! hasEdgeTo: t1  	^ outNeighbors includes: t1! ! !ExplicitGraphNode methodsFor: 'initialize'! initializeFixed: t1  	outNeighbors := Array new: t1! ! !ExplicitGraphNode methodsFor: 'initialize'! initializeOrdered 	outNeighbors := OrderedCollection new. 	inNeighbors := OrderedCollection new! ! !ExplicitGraphNode methodsFor: 'initialize'! initializeUnordered 	outNeighbors := Set new. 	inNeighbors := Set new! ! !ExplicitGraphNode methodsFor: 'testing'! isAnExtremity 	^ self isFinal | self isInitial | self isExtremal! ! !ExplicitGraphNode methodsFor: 'testing'! isExtremal 	^ self inOutDegree = #(1 1 ) & self inNeighbors = self outNeighbors! ! !ExplicitGraphNode methodsFor: 'testing'! isFinal 	^ self inOutDegree = #(1 0 )! ! !ExplicitGraphNode methodsFor: 'testing'! isInitial 	^ self inOutDegree = #(0 1 )! ! !ExplicitGraphNode methodsFor: 'testing'! isLabelled 	^ false! ! !ExplicitGraphNode methodsFor: 'testing'! isMiddle 	^ (self inDegree + self outDegree between: 2 and: 4) 		& (self inNeighbors union: self outNeighbors) size = 2! ! !ExplicitGraphNode methodsFor: 'testing'! isOrdered 	^ outNeighbors isSequenceable! ! !ExplicitGraphNode methodsFor: 'accessing edges'! neighborsDo: t1  	outNeighbors do: t1! ! !ExplicitGraphNode methodsFor: 'accessing edges'! outNeighborsDo: t1  	outNeighbors do: t1! ! !ExplicitGraphNode methodsFor: 'accessing edges'! strictInNeighbors 	| t1 | 	t1 := inNeighbors copy. 	(t1 includes: self) 		ifTrue: [^ t1 remove: self; 				 yourself]. 	^ t1! ! !ExplicitGraphNode methodsFor: 'accessing edges'! strictNeighbors 	| t1 | 	t1 := outNeighbors copy. 	^ t1 remove: self; 		 yourself! ! !ExplicitGraphNode methodsFor: 'accessing edges'! strictOutNeighbors 	| t1 | 	t1 := outNeighbors copy. 	(t1 includes: self) 		ifTrue: [^ t1 remove: self; 				 yourself]. 	^ t1! ! !ExplicitGraphNode methodsFor: 'changing edges'! removeInNeighbor: t1  	(inNeighbors includes: t1) 		ifTrue: [inNeighbors remove: t1]. 	^ t1! ! !ExplicitGraphNode methodsFor: 'changing edges'! removeNeighbor: t1  	t1 removeInNeighbor: self. 	^ outNeighbors remove: t1! ! !ExplicitGraphNode methodsFor: 'changing edges'! removeOutNeighbor: t1  	t1 removeInNeighbor: self. 	^ outNeighbors remove: t1! ! !ExplicitGraphNode methodsFor: 'private'! setNeighbors: t1  	outNeighbors := t1! ! !ExplicitGraphNode methodsFor: 'private'! setOutNeighbors: t1  	outNeighbors := t1! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! ExplicitGraphNode class 	instanceVariableNames: ''! !ExplicitGraphNode class methodsFor: 'instance creation'! arity: t1  	^ super new initializeFixed: t1! ! !ExplicitGraphNode class methodsFor: 'instance creation'! binary 	^ super new initializeFixed: 2! ! !ExplicitGraphNode class methodsFor: 'instance creation'! binary: t1  	^ super new initializeFixed: 2; 		 value: t1! ! !ExplicitGraphNode class methodsFor: 'instance creation'! new 	^ super new initializeUnordered! ! !ExplicitGraphNode class methodsFor: 'instance creation'! newOn: t1  	^ super new initializeUnordered; value: t1! ! !ExplicitGraphNode class methodsFor: 'instance creation'! on: t1 arity: t2  	^ super new initializeFixed: t2; 		 value: t1! ! !ExplicitGraphNode class methodsFor: 'instance creation'! ordered 	^ super new initializeOrdered! ! !ExplicitGraphNode class methodsFor: 'instance creation'! ordered: t1  	^ super new initializeOrdered; value: t1! !  ExplicitGraphNode subclass: #LabelledExplicitGraphNode 	instanceVariableNames: '' 	classVariableNames: '' 	poolDictionaries: '' 	category: 'Graphs-Collections-Graphs'! !LabelledExplicitGraphNode methodsFor: 'changing edges'! addNeighbor: t1  	self shouldNotImplement! ! !LabelledExplicitGraphNode methodsFor: 'changing edges'! addNeighbor: t1 at: t2  	self shouldNotImplement! ! !LabelledExplicitGraphNode methodsFor: 'changing edges'! addNeighbor: t1 at: t2 label: t3  	^ super addNeighbor: t1 -> t3 at: t2! !

!LabelledExplicitGraphNode methodsFor: 'changing edges'!
addNeighbor: t1 label: t2
	^ super addNeighbor: t1 -> t2! !

!LabelledExplicitGraphNode methodsFor: 'changing edges'!
removeNeighbor: t1
	outNeighbors
		remove: (outNeighbors
				detect: [:t2 | t2 key = t1])! !

!LabelledExplicitGraphNode methodsFor: 'changing edges'!
removeOutNeighbor: t1
	outNeighbors
		remove: (outNeighbors
				detect: [:t2 | t2 key = t1])! !

!LabelledExplicitGraphNode methodsFor: 'testing edges'!
hasEdgeTo: t1
	^ outNeighbors
		anySatisfy: [:t2 | t2 key = t1]! !

!LabelledExplicitGraphNode methodsFor: 'testing'!
isLabelled
	^ true! !

!LabelledExplicitGraphNode methodsFor: 'accessing edges'!
labelOfEdgeTo: t1
	^ (outNeighbors
		detect: [:t2 | t2 key = t1]) value! !

!LabelledExplicitGraphNode methodsFor: 'accessing edges'!
labelOfEdgeTo: t1 ifNone: t2
	^ (outNeighbors
		detect: [:t3 | t3 key = t1]
		ifNone: [^ t2 value]) value! !

!LabelledExplicitGraphNode methodsFor: 'accessing edges'!
neighborsAndLabelsDo: t1
	^ outNeighbors
		do: [:t2 | t1 value: t2 key value: t2 value]! !

!LabelledExplicitGraphNode methodsFor: 'accessing edges'!
neighborsDo: t1
	^ outNeighbors
		do: [:t2 | t1 value: t2 key]! !

!LabelledExplicitGraphNode methodsFor: 'accessing edges'!
outNeighbors
	^ outNeighbors
		collect: [:t1 | t1 key]! !

Graph initialize!

Graphs-Morphic-Graphs.st

Morph subclass: #EdgeMorph
	instanceVariableNames: 'source destination'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphs-Morphic-Graphs'!

!EdgeMorph methodsFor: 'private'!
adjustBounds
	self
		bounds: (self sourcePoint rect: self destinationPoint)! !

!EdgeMorph methodsFor: 'geometry-testing'!
containsPoint: t1
	^ false! !

!EdgeMorph methodsFor: 'accessing'!
destination
	^ destination! !

!EdgeMorph methodsFor: 'accessing'!
destination: t1
	destination := t1! !

!EdgeMorph methodsFor: 'accessing'!
destinationPoint
	^ destination center! !

!EdgeMorph methodsFor: 'accessing'!
source
	^ source! !

!EdgeMorph methodsFor: 'accessing'!
source: t1
	source := t1! !

!EdgeMorph methodsFor: 'accessing'!
sourcePoint
	^ source center! !

!EdgeMorph methodsFor: 'drawing'!
drawOn: t1
	t1
		line: self sourcePoint
		to: self destinationPoint
		width: 1
		color: self color! !

!EdgeMorph methodsFor: 'initialization'!
initialize
	super initialize.
	self color: Color black! !

!EdgeMorph methodsFor: 'stepping'!
step
	(source owner isNil
			or: [destination owner isNil])
		ifTrue: [^ self delete].
	self adjustBounds! !

!EdgeMorph methodsFor: 'stepping'!
stepTime
	^ 0! !

Morph subclass: #GraphNodeMorph
	instanceVariableNames: 'node'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphs-Morphic-Graphs'!

!GraphNodeMorph methodsFor: 'neighbors'!
addNeighbors: t1
	Transcript show: 'test'! !

!GraphNodeMorph methodsFor: 'as yet unclassified'!
doubleClick: t1
	self showBalloon: 'doubleClick' hand: t1 hand.
	self
		color: (color = Color blue
				ifTrue: [Color red]
				ifFalse: [Color blue])! !

!GraphNodeMorph methodsFor: 'drawing'!
drawOn: t1
	^ self! !

!GraphNodeMorph methodsFor: 'initialization'!
initialize
	super initialize.
	self extent: 10 @ 10! !

!GraphNodeMorph methodsFor: 'accessing'!
node
	^ node! !

!GraphNodeMorph methodsFor: 'accessing'!
node: t1
	| t2 t3 |
	node := t1.
	t3 := EllipseMorph new extent: 6 @ 6;

				color: (Color
						r: 1.0
						g: 0.452
						b: 0.065).
	t3 align: t3 center with: self center.
	self addMorph: t3.
	t2 := StringMorph new contents: t1 value printString.
	t2 align: t2 bounds leftCenter with: bounds rightCenter + (4 @ 0).
	self addMorph: t2! !

GraphNodeMorph subclass: #SpringsNodeMorph
	instanceVariableNames: 'dxdy'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphs-Morphic-Graphs'!

!SpringsNodeMorph methodsFor: 'moving'!
aboutToBeGrabbedBy: t1
	super aboutToBeGrabbedBy: t1.
	owner focusOn: node! !

!SpringsNodeMorph methodsFor: 'moving'!
doMove
	(owner bounds containsPoint: self position)
		ifTrue: [self position: self position + dxdy]
		ifFalse: [self position: self position + (2
						* (bounds amountToTranslateWithin: owner bounds)).
			self dxdy: 0 @ 0].
	^ self dxdy r! !

!SpringsNodeMorph methodsFor: 'moving'!
nearbyNodesDo3: t1
	| t2 |
	t2 := 0.
	node
		markDo: [:t3 |
			t2 := t2 + 1.
			t2 > 40
				ifTrue: [^ self].
			t1
				value: (owner nodeToMorph at: t3)]! !

!SpringsNodeMorph methodsFor: 'moving'!
nearbyNodesDo: t1
	| t2 |
	t2 := 0.
	node
		markDo: [:t3 |
			t2 := t2 + 1.
			t2 > 40
				ifTrue: [^ self].
			t1
				value: (owner nodeToMorph at: t3)]! !

!SpringsNodeMorph methodsFor: 'moving'!
separateFromAllNodes
	| t1 t2 t3 |
	t1 := 0 @ 0.
	t2 := self center.
	(owner isKindOf: SpringsGraphMorph)
		ifFalse: [^ self].
	owner
		nodesDo: [:t4 |
			t3 := t4 center + t4 dxdy.
			self == t4
				ifFalse: [t2 = t3
						ifTrue: [t1 := t1 + (3 atRandom - 2 @ (3 atRandom - 2))]
						ifFalse: [t1 := t1 + (t2 - t3
											/ (t2 squaredDistanceTo: t3))]]].
	t1 isZero
		ifFalse: [self dxdy: self dxdy + (t1 / t1 r * 2)]! !

!SpringsNodeMorph methodsFor: 'as yet unclassified' stamp: 'sam 4/11/2005 20:58'!
click: t1
	self node value browse.! !

!SpringsNodeMorph methodsFor: 'as yet unclassified'!
handlesMouseDown: t1
	t1 shiftPressed
		ifTrue: [^ true].
	^ super handlesMouseDown: t1! !

!SpringsNodeMorph methodsFor: 'as yet unclassified'!
mouseDown: t1
	t1 hand
		waitForClicksOrDrag: self
		event: t1
		selectors: {#click:. #doubleClick:. #firstClickTimedOut:. nil}
		threshold: 5! !

!SpringsNodeMorph methodsFor: 'as yet unclassified'!
wantsSteps
	^ false! !

!SpringsNodeMorph methodsFor: 'accessing'!
dxdy
	^ dxdy! !

!SpringsNodeMorph methodsFor: 'accessing'!
dxdy: t1
	dxdy := t1! !

!SpringsNodeMorph methodsFor: 'accessing'!
step
	self separateFromAllNodes! !

!SpringsNodeMorph methodsFor: 'accessing'!
stepTime
	^ 0! !

!SpringsNodeMorph methodsFor: 'initialization'!
initialize
	super initialize.
	dxdy := 0 @ 0! !

GraphNodeMorph subclass: #RadialNodeMorph
	instanceVariableNames: 'startRadius startAngle endRadius endAngle startTime endTime'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphs-Morphic-Graphs'!

!RadialNodeMorph methodsFor: 'as yet unclassified'!
moveToRadius: t1 angle: t2 time: t3
	t3 		ifTrue: [^ self
				position: (owner polarToCartesian: t1 @ t2)].
	startRadius := (self center - owner origin) r.
	startAngle := (self center - owner origin) degrees.
	endRadius := t1.
	endAngle := t2 + 0.5 \\ 360.
	(endAngle - 360 - startAngle) abs < (endAngle - startAngle) abs 		ifTrue: [endAngle := endAngle - 360]. 	startTime := Time millisecondClockValue. 	endTime := startTime + t3. 	self startStepping! ! !RadialNodeMorph methodsFor: 'as yet unclassified'! step 	| t1 t2 | 	startTime isNil 		ifTrue: [^ self stopStepping]. 	t1 := Time millisecondClockValue - startTime / (endTime - startTime). 	(t1 >= 1
			or: [t1 < 0]) 		ifTrue: [^ self stopStepping; 				align: self center 				with: (owner polarToCartesian: endRadius @ endAngle)]. 	t1 := t1 - 0.5 * 2. 	t1 := t1 arcTan. 	t1 := t1 + 1 / 2. 	t2 := startRadius @ startAngle interpolateTo: endRadius @ endAngle at: t1. 	self 		align: bounds center 		with: (owner polarToCartesian: t2). 	self changed! ! !RadialNodeMorph methodsFor: 'as yet unclassified'! stepTime 	^ 0! !  Morph subclass: #DirectedEdgeMorph 	instanceVariableNames: 'source destination' 	classVariableNames: '' 	poolDictionaries: '' 	category: 'Graphs-Morphic-Graphs'! !DirectedEdgeMorph methodsFor: 'private'! adjustBounds 	self 		bounds: (self sourcePoint rect: self destinationPoint)! ! !DirectedEdgeMorph methodsFor: 'geometry-testing'! containsPoint: t1  	^ false! ! !DirectedEdgeMorph methodsFor: 'accessing'! destination 	^ destination! ! !DirectedEdgeMorph methodsFor: 'accessing'! destination: t1  	destination := t1! ! !DirectedEdgeMorph methodsFor: 'accessing'! destinationPoint 	^ destination center! ! !DirectedEdgeMorph methodsFor: 'accessing'! source 	^ source! ! !DirectedEdgeMorph methodsFor: 'accessing'! source: t1  	source := t1! ! !DirectedEdgeMorph methodsFor: 'accessing'! sourcePoint 	^ source center! ! !DirectedEdgeMorph methodsFor: 'drawing'! drawOn: t1  	self sourcePoint = self destinationPoint 		ifFalse: [t1 				drawThinArrowFrom: self sourcePoint 				to: self destinationPoint 				width: 1 				color: self color]! ! !DirectedEdgeMorph methodsFor: 'initialization'! initialize 	super initialize. 	self color: Color black! ! !DirectedEdgeMorph methodsFor: 'stepping'! step 	(source owner isNil 			or: [destination owner isNil]) 		ifTrue: [^ self delete]. 	self adjustBounds! ! !DirectedEdgeMorph methodsFor: 'stepping'! stepTime 	^ 0! !  DirectedEdgeMorph subclass: #SpringEdgeMorph 	instanceVariableNames: 'desiredDistance' 	classVariableNames: '' 	poolDictionaries: '' 	category: 'Graphs-Morphic-Graphs'! !SpringEdgeMorph methodsFor: 'as yet unclassified'! approachNodes 	| t1 t2 t3 t4 | 	(t2 := (t3 := source center + source dxdy - destination center - destination dxdy) r) > desiredDistance
		ifTrue: [t1 := (desiredDistance - t2) asFloat / (t2 * 4).
			t4 := t3 * t1 / 2.
			destination dxdy: destination dxdy - t4.
			source dxdy: source dxdy + t4]! !

!SpringEdgeMorph methodsFor: 'as yet unclassified'!
desiredDistance: t1
	desiredDistance := t1! !

!SpringEdgeMorph methodsFor: 'as yet unclassified'!
initialize
	super initialize.
	desiredDistance := 100! !

!SpringEdgeMorph methodsFor: 'as yet unclassified'!
step
	(source owner isNil
			or: [destination owner isNil])
		ifTrue: [^ self delete].
	self adjustBounds! !

SystemWindow subclass: #GraphSystemWindow
	instanceVariableNames: 'graphLayoutMorph switchDraw switchMetrics switchDebug'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphs-Morphic-Graphs'!

!GraphSystemWindow methodsFor: 'menu'!
askArgumentsFor: t1
	| t2 t3 |
	t2 := t1 findTokens: $:.
	t3 := OrderedCollection new: t2 size.
	t2
		do: [:t4 | t3
				add: (Object
						readFromString: (FillInTheBlank request: 'Enter a number for: ' , t4))].
	^ t3 asArray! !

!GraphSystemWindow methodsFor: 'menu'!
getArgumentsFor: t1
	(t1 includes: $:)
		ifTrue: [^ self askArgumentsFor: t1].
	^ #()! !

!GraphSystemWindow methodsFor: 'creation'!
createButtons
	| t1 t2 |
	t1 := AlignmentMorph newRow.
	t1 color: Color transparent.
	t2 := self createMenuButtonFor: #createInspectActions title: 'Inspect'.
	t1 addMorphBack: t2.
	t2 := self createMenuButtonFor: #createMetricsActions title: 'Metrics'.
	t1 addMorphBack: t2.
	t2 := self createGraphSelectionButton.
	t1 addMorphBack: t2.
	t2 := (PluggableButtonMorph
				on: switchDraw
				getState: #isOn
				action: #switch)
				label: 'Visual On/Off'.
	t2
		onColor: Color lightGreen
		offColor: (Color
				r: 0.62
				g: 0.76
				b: 0.48).
	t1 addMorphBack: t2.
	t2 := (PluggableButtonMorph
				on: switchMetrics
				getState: #isOn
				action: #switch)
				label: 'Metrics On/Off'.
	t2
		onColor: Color lightGreen
		offColor: (Color
				r: 0.62
				g: 0.76
				b: 0.48).
	t1 addMorphBack: t2.
	t2 := (PluggableButtonMorph
				on: switchDebug
				getState: #isOn
				action: #switch)
				label: 'Debug On/Off'.
	t2
		onColor: Color lightGreen
		offColor: (Color
				r: 0.62
				g: 0.76
				b: 0.48).
	t1 addMorphBack: t2.
	^ t1! !

!GraphSystemWindow methodsFor: 'creation'!
createClearActions
	| t1 |
	t1 := OrderedCollection new.
	t1 add: {'Clear all'. graphLayoutMorph. #clearAll. #()};
		 add: {'Clear nodes'. graphLayoutMorph. #clearNodes. #()};
		 add: {'Clear edges'. graphLayoutMorph. #clearEdges. #()}.
	^ t1! !

!GraphSystemWindow methodsFor: 'creation'!
createGraphFrom: t1
	| t2 t3 |
	t3 := self getArgumentsFor: t1.
	t2 := self graphClass perform: t1 withArguments: t3.
	^ t2! !

!GraphSystemWindow methodsFor: 'creation'!
createGraphLayoutMorph
	graphLayoutMorph := SpringsGraphMorph new! !

!GraphSystemWindow methodsFor: 'creation'!
createGraphSelectionButton
	| t1 |
	t1 := UpdatingSimpleButtonMorph newWithLabel: 'Graphs'.
	t1 borderWidth: 2;
		 borderColor: #raised;
		 color: Color transparent;
		 cornerStyle: #squared;
		 actWhen: #buttonUp;
		 target: self;
		 actionSelector: #createGraphsMenuFor:;
		 arguments: {self graphClass}.
	^ t1! !

!GraphSystemWindow methodsFor: 'creation'!
createGraphsMenuFor: t1
	| t2 |
	t2 := MenuMorph entitled: 'Graphs'.
	t2 addStayUpItem.
	t1 class methodDict
		keysDo: [:t3 | ((t3 beginsWith: 'example')
					or: [t3 beginsWith: 'fixture'])
				ifTrue: [t2
						add: t3
						target: self
						selector: #initializeFrom:
						argument: t3]].
	t2 popUpInWorld! !

!GraphSystemWindow methodsFor: 'creation'!
createInspectActions
	| t1 |
	t1 := OrderedCollection new.
	t1 add: {'Inspect graph'. self. #inspectGraph. #()}.
	t1 add: {'Inspect layout'. self. #inspectLayout. #()}.
	t1 add: {'Inspect window'. self. #inspectSystemWindow. #()}.
	^ t1! !

!GraphSystemWindow methodsFor: 'creation'!
createMenu: t1 selector: t2
	| t3 |
	t3 := MenuMorph entitled: t1.
	t3 addStayUpItem.
	(self perform: t2)
		do: [:t4 | t3
				add: t4 first
				target: t4 second
				selector: t4 third
				argument: t4 fourth].
	t3 popUpInWorld! !

!GraphSystemWindow methodsFor: 'creation'!
createMenuButtonFor: t1 title: t2
	| t3 |
	t3 := UpdatingSimpleButtonMorph newWithLabel: t2.
	t3 borderWidth: 2;
		 borderColor: #raised;
		 color: Color transparent;
		 actWhen: #buttonUp;
		 target: self;
		 actionSelector: #createMenu:selector:;
		 arguments: {t2. t1}.
	^ t3! !

!GraphSystemWindow methodsFor: 'creation'!
createMetricsActions
	| t1 |
	t1 := OrderedCollection new.
	t1 add: {'Degree Distribution'. self. #openPlotMorphOnGraphPerforming:. {#degreeDistribution. 'k'. 'P(k)'}};
		 add: {'InDegree Distribution'. self. #openPlotMorphOnGraphPerforming:. {#inDegreeDistribution. 'k'. 'Pin(k)'}};
		 add: {'OutDegree Distribution'. self. #openPlotMorphOnGraphPerforming:. {#outDegreeDistribution. 'k'. 'Pout(k)'}};
		 add: {'Average path length'. self. #popUpValue:. #averagePathLength};
		 add: {'Apr. average path length'. self. #popUpValue:. #averagePathLengthAcuteAt};
		 add: {'Clustering coefficient'. self. #popUpValue:. #clusteringCoefficient}.
	^ t1! !

!GraphSystemWindow methodsFor: 'creation'!
openPlotMorphOnGraphPerforming: t1
	| t2 t3 |
	t2 := GraphPlotMorph new extent: 300 @ 300.
	t2 title: t1 first.
	t2 xlabel: t1 second.
	t2 ylabel: t1 third.
	t2 series: t1 first drawLine: false.
	t2 series: t1 first color: Color white.
	t3 := graphLayoutMorph graph perform: t1 first.
	t3
		associationsDo: [:t4 | t2 series: t1 first addPoint: t4 key @ (t4 value * 100)].
	t2 openInWorld! !

!GraphSystemWindow methodsFor: 'debugging'!
debugValue
	^ switchDebug! !

!GraphSystemWindow methodsFor: 'debugging'!
inspectGraph
	graphLayoutMorph graph inspect! !

!GraphSystemWindow methodsFor: 'debugging'!
inspectLayout
	graphLayoutMorph inspect! !

!GraphSystemWindow methodsFor: 'debugging'!
inspectSystemWindow
	self inspect! !

!GraphSystemWindow methodsFor: 'accessing'!
graphClass
	^ Graph! !

!GraphSystemWindow methodsFor: 'accessing'!
popUpValue: t1
	| t2 t3 |
	t3 := (graphLayoutMorph graph perform: t1) asString.
	t2 := MenuMorph entitled: t1.
	t2 addStayUpItem.
	t2 add: t3 action: nil.
	t2 popUpInWorld! !

!GraphSystemWindow methodsFor: 'initialization'!
initialize
	| t1 |
	super initialize.
	self createGraphLayoutMorph.
	switchDraw := Switch newOn.
	switchDraw
		onAction: [graphLayoutMorph toggleDraw].
	switchDraw
		offAction: [graphLayoutMorph toggleDraw].
	switchMetrics := Switch newOn.
	switchMetrics
		onAction: [graphLayoutMorph toggleMetrics].
	switchMetrics
		offAction: [graphLayoutMorph toggleMetrics].
	switchDebug := Switch newOn.
	switchDebug
		onAction: [graphLayoutMorph toggleDebugging].
	switchDebug
		offAction: [graphLayoutMorph toggleDebugging].
	t1 := graphLayoutMorph extent.
	self
		model: (Form extent: t1 depth: Display depth).
	self
		setWindowColor: (Color
				r: 0.628
				g: 0.769
				b: 0.486).
	self color: Color paleGreen lighter lighter lighter.
	self initializeWindowWith: t1! !

!GraphSystemWindow methodsFor: 'initialization'!
initializeFrom: t1
	graphLayoutMorph clearAll.
	graphLayoutMorph
		graph: (self createGraphFrom: t1)! !

!GraphSystemWindow methodsFor: 'initialization'!
initializeWindowWith: t1
	self
		addMorph: self createButtons
		frame: (0.0 @ 0.0 rect: 1.0 @ (28 / t1 y)).
	self
		addMorph: graphLayoutMorph
		frame: (0.0 @ (28 / t1 y) rect: 1.0 @ 1.0)! !

!GraphSystemWindow methodsFor: 'initialization'!
initializeWith: t1
	graphLayoutMorph clearAll.
	graphLayoutMorph graph: t1! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

GraphSystemWindow class
	instanceVariableNames: ''!

!GraphSystemWindow class methodsFor: 'accessing'!
label
	^ 'GraphSystemWindow'! !

!GraphSystemWindow class methodsFor: 'instance creation'!
newWith: t1
	^ (self labelled: self label) initializeWith: t1;
		 openInWorld! !

!GraphSystemWindow class methodsFor: 'instance creation'!
open
	^ (self labelled: self label) initialize; openInWorld! !

Morph subclass: #DirectedEdgeMorph2
	instanceVariableNames: 'source destination'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphs-Morphic-Graphs'!

!DirectedEdgeMorph2 methodsFor: 'private'!
adjustBounds
	self
		bounds: (self sourcePoint rect: self destinationPoint)! !

!DirectedEdgeMorph2 methodsFor: 'geometry-testing'!
containsPoint: t1
	^ false! !

!DirectedEdgeMorph2 methodsFor: 'accessing'!
destination
	^ destination! !

!DirectedEdgeMorph2 methodsFor: 'accessing'!
destination: t1
	destination := t1.
	self drawMe! !

!DirectedEdgeMorph2 methodsFor: 'accessing'!
destinationPoint
	^ destination center! !

!DirectedEdgeMorph2 methodsFor: 'accessing'!
source
	^ source! !

!DirectedEdgeMorph2 methodsFor: 'accessing'!
source: t1
	source := t1! !

!DirectedEdgeMorph2 methodsFor: 'accessing'!
sourcePoint
	^ source center! !

!DirectedEdgeMorph2 methodsFor: 'drawing'!
drawMe
	| t1 |
	t1 := PolygonMorph new.
	t1 computeArrowFormAt: self sourcePoint from: self destinationPoint.
	self addMorph: t1! !

!DirectedEdgeMorph2 methodsFor: 'drawing'!
drawOn: t1
	^ self! !

!DirectedEdgeMorph2 methodsFor: 'initialization'!
initialize
	super initialize! !

!DirectedEdgeMorph2 methodsFor: 'stepping'!
step
	(source owner isNil
			or: [destination owner isNil])
		ifTrue: [^ self delete].
	self adjustBounds! !

!DirectedEdgeMorph2 methodsFor: 'stepping'!
stepTime
	^ 0! !

GraphNodeMorph subclass: #FixedSpringsNodeMorph
	instanceVariableNames: 'dxdy'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphs-Morphic-Graphs'!

!FixedSpringsNodeMorph methodsFor: 'moving'!
aboutToBeGrabbedBy: t1
	super aboutToBeGrabbedBy: t1.
	owner focusOn: node! !

!FixedSpringsNodeMorph methodsFor: 'moving'!
doMove
	self position: self position + dxdy.
	^ self dxdy r! !

!FixedSpringsNodeMorph methodsFor: 'moving'!
nearbyNodesDo3: t1
	| t2 |
	t2 := 0.
	node
		markDo: [:t3 |
			t2 := t2 + 1.
			t2 > 40
				ifTrue: [^ self].
			t1
				value: (owner nodeToMorph at: t3)]! !

!FixedSpringsNodeMorph methodsFor: 'moving'!
nearbyNodesDo: t1
	| t2 |
	t2 := 0.
	node
		markDo: [:t3 |
			t2 := t2 + 1.
			t2 > 40
				ifTrue: [^ self].
			t1
				value: (owner nodeToMorph at: t3)]! !

!FixedSpringsNodeMorph methodsFor: 'moving'!
separateFromAllNodes
	| t1 t2 t3 |
	t1 := 0 @ 0.
	t2 := self center.
	(owner isKindOf: SpringsGraphMorph)
		ifFalse: [^ self].
	owner
		nodesDo: [:t4 |
			t3 := t4 center + t4 dxdy.
			self == t4
				ifFalse: [t2 = t3
						ifTrue: [t1 := t1 + (3 atRandom - 2 @ (3 atRandom - 2))]
						ifFalse: [t1 := t1 + (t2 - t3
											/ (t2 squaredDistanceTo: t3))]]].
	t1 isZero
		ifFalse: [self dxdy: self dxdy + (t1 / t1 r * 2)]! !

!FixedSpringsNodeMorph methodsFor: 'accessing'!
dxdy
	^ dxdy! !

!FixedSpringsNodeMorph methodsFor: 'accessing'!
dxdy: t1
	dxdy := t1! !

!FixedSpringsNodeMorph methodsFor: 'accessing'!
step
	self separateFromAllNodes! !

!FixedSpringsNodeMorph methodsFor: 'accessing'!
stepTime
	^ 0! !

!FixedSpringsNodeMorph methodsFor: 'initialization'!
initialize
	super initialize.
	dxdy := 0 @ 0! !

!FixedSpringsNodeMorph methodsFor: 'as yet unclassified'!
wantsSteps
	^ false! !

PackageInfo subclass: #GraphMorphInfo
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphs-Morphic-Graphs'!

!GraphMorphInfo methodsFor: 'as yet unclassified'!
methodCategoryPrefix
	^ '*graphmorph'! !

!GraphMorphInfo methodsFor: 'as yet unclassified'!
prerequisiteChangeSets
	^ #('Collections-Misc' 'Iterator' )! !

!GraphMorphInfo methodsFor: 'as yet unclassified'!
prerequisitePackages
	^ #('Collections-Graphs' )! !

!GraphMorphInfo methodsFor: 'as yet unclassified'!
readmeText
	^ '
This is a new version of Collection-Graphs and Morphic-Graphs, more usable than
the previous one.

Try this..
Samir Saidani.

|layout|
layout_GraphLayoutMorph new openInWorld.
layout graph:(Graph exampleGraph ).
(layout graph) addNode: #k.
(layout graph) addEdge: #k -> #r2.
(layout graph) removeEdge: #r1 -> #n1.
layout clearAll.
layout redraw.
layout clearAll.
layout graph:(Graph exampleGraph3 ).
layout redraw.
(layout graph) addNode: #k.
(layout graph) addEdge: #k -> #r2.
(layout graph) removeEdge: #r1 -> #n1.

'! !

ProtoObject subclass: #GraphPlotMorph
	instanceVariableNames: 'xlabel ylabel logscale'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphs-Morphic-Graphs'!

!GraphPlotMorph methodsFor: 'menus'!
addCustomMenuItems: t1 hand: t2
	| t3 t4 |
	t3 := t1 items
				detect: [:t5 | t5 contents = 'export...'].
	t4 := MenuMorph new defaultTarget: self.
	super addCustomMenuItems: t1 hand: t2.
	t1 addLine.
	t1
		addUpdating: #logscaleString
		target: self
		action: #toggleLogscale.
	t1
		add: 'draw Poisson curve'
		target: self
		action: #drawPoissonCurve.
	t1
		add: 'Clear'
		target: self
		action: #clear.
	t3 subMenu add: 'Gnuplot file' subMenu: t4.
	t1 add: 'export to Gnuplot' subMenu: t4.
	self series
		keysDo: [:t6 | t4
				add: t6
				target: self
				selector: #exportToGnuplot:
				argument: t6]! !

!GraphPlotMorph methodsFor: 'menus'!
clear
	self series
		associationsDo: [:t1 | t1 key = #degreeDistribution
				ifFalse: [t1 value clear]].
	self changed! !

!GraphPlotMorph methodsFor: 'menus'!
drawPoissonCurve
	| t1 t2 t4 |
	t1 := (self series at: #degreeDistribution) points.
	t2 := t1 first x + t1 last x / 2.
	(self series: #poissonCurve) clear.
	self series: #poissonCurve drawLine: true.
	self series: #poissonCurve color: Color green.
	t1
		do: [:t3 |
			t4 := t2 negated exp * ((t2 raisedTo: t3 x)
							/ t3 x factorial).
			self series: #poissonCurve addPoint: t3 x @ (t4 * 100)]! !

!GraphPlotMorph methodsFor: 'menus'!
exportToGnuplot
	| t1 |
	t1 := CrLfFileStream newFileNamed: (FillInTheBlank request: 'Enter a filename:')
					, '.gpm'.
	t1 ascii.
	t1 nextPutAll: 'set title ';
		 nextPut: $';
		 nextPutAll: self title contents;
		 nextPut: $';
		 nextPut: Character cr;
		 nextPutAll: 'set xlabel ';
		 nextPut: $';
		 nextPutAll: self xlabel;
		 nextPut: $';
		 nextPut: Character cr;
		 nextPutAll: 'set ylabel ';
		 nextPut: $';
		 nextPutAll: self ylabel;
		 nextPut: $';
		 nextPut: Character cr;
		 nextPutAll: 'plot ''-'' title "Degree distribution"';
		 nextPut: Character cr.
	(self series at: #degreeDistribution) points
		do: [:t2 | t1 nextPutAll: t2 x asString;
				 nextPutAll: '   ';
				 nextPutAll: (t2 y / 100.0) asString;
				 nextPut: Character cr].
	t1 nextPutAll: 'e';
		 nextPut: Character cr;
		 nextPutAll: 'pause -1 ''Press Enter...''';
		 nextPut: Character cr! !

!GraphPlotMorph methodsFor: 'menus'!
exportToGnuplot: t1
	| t2 |
	t2 := CrLfFileStream newFileNamed: (FillInTheBlank request: 'Enter a filename:')
					, '.gpm'.
	t2 ascii.
	t2 nextPutAll: 'set title ';
		 nextPut: $';
		 nextPutAll: self title contents;
		 nextPut: $';
		 nextPut: Character cr;
		 nextPutAll: 'set xlabel ';
		 nextPut: $';
		 nextPutAll: self xlabel;
		 nextPut: $';
		 nextPut: Character cr;
		 nextPutAll: 'set ylabel ';
		 nextPut: $';
		 nextPutAll: self ylabel;
		 nextPut: $';
		 nextPut: Character cr;
		 nextPutAll: 'plot ''-'' title "' , t1 asString , '"';
		 nextPut: Character cr.
	(self series at: t1) points
		do: [:t3 | t2 nextPutAll: t3 x asString;
				 nextPutAll: '   ';
				 nextPutAll: (t3 y / 100.0) asString;
				 nextPut: Character cr].
	t2 nextPutAll: 'e';
		 nextPut: Character cr;
		 nextPutAll: 'pause -1 ''Press Enter...''';
		 nextPut: Character cr! !

!GraphPlotMorph methodsFor: 'menus'!
logscaleString
	^ (self logscale
		ifTrue: ['']
		ifFalse: [''])
		, 'logscale'! !

!GraphPlotMorph methodsFor: 'menus'!
toggleLogscale
	self logscale
		ifTrue: [self series anyOne points
				do: [:t1 | t1
						setX: (10 raisedTo: t1 x)
						setY: (10 raisedTo: t1 y)]]
		ifFalse: [self series anyOne points
				do: [:t1 | t1 setX: t1 x log setY: t1 y log]].
	logscale := logscale not.
	self changed! !

!GraphPlotMorph methodsFor: 'initialization'!
initialize
	super initialize.
	self extent: 1 @ 1.
	self xlabel: ''.
	self ylabel: ''.
	logscale := false! !

!GraphPlotMorph methodsFor: 'accessing'!
logscale
	^ logscale! !

!GraphPlotMorph methodsFor: 'accessing'!
title
	^ title! !

!GraphPlotMorph methodsFor: 'accessing'!
xlabel
	^ xlabel! !

!GraphPlotMorph methodsFor: 'accessing'!
xlabel: t1
	xlabel := t1! !

!GraphPlotMorph methodsFor: 'accessing'!
ylabel
	^ ylabel! !

!GraphPlotMorph methodsFor: 'accessing'!
ylabel: t1
	ylabel := t1! !

PasteUpMorph subclass: #GraphLayoutMorph
	instanceVariableNames: 'graph nodeToMorph edgeToMorph focusNode draw metrics debug'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphs-Morphic-Graphs'!

!GraphLayoutMorph methodsFor: 'event handling'!
acceptDroppingMorph: t1 event: t2
	(t1 isKindOf: self nodeClass)
		ifTrue: [self addMorph: t1.
			self focusOn: t1 node.
			^ self startStepping].
	^ super acceptDroppingMorph: t1 event: t2! !

!GraphLayoutMorph methodsFor: 'event handling'!
allowSubmorphExtraction
	^ false! !

!GraphLayoutMorph methodsFor: 'private'!
addEdge: t1
	^ self addEdge: t1 label: nil! !

!GraphLayoutMorph methodsFor: 'private'!
addEdge: t1 label: t2
	| t3 t4 |
	(self graph nodes includes: t1 key)
		ifFalse: [self error: 'no nodes on the model'].
	(self graph nodes includes: t1 value)
		ifFalse: [self error: 'no nodes on the model'].
	t3 := self graph getNode: t1 key.
	t4 := self graph getNode: t1 value.
	^ self privateAddEdge: t3 -> t4 label: t2! !

!GraphLayoutMorph methodsFor: 'private'!
addNode: t1
	| t2 |
	(nodeToMorph includesKey: t1)
		ifTrue: [^ nodeToMorph at: t1].
	t2 := self nodeClass new node: t1.
	nodeToMorph at: t1 put: t2.
	t2 position: (bounds left to: bounds right) atRandom @ (bounds top to: bounds bottom) atRandom.
	self addMorph: t2.
	t1
		neighborsAndLabelsDo: [:t3 :t4 |
			self addNode: t3.
			self privateAddEdge: t1 -> t3 label: t4].
	^ t2! !

!GraphLayoutMorph methodsFor: 'private'!
privateAddEdge: t1 label: t2
	| t3 t4 t5 |
	t4 := Array with: t1 key with: t1 value.
	(edgeToMorph includesKey: t4)
		ifTrue: [^ edgeToMorph at: t4].
	t3 := self edgeClass new.
	edgeToMorph at: t4 put: t3.
	t3
		source: (nodeToMorph at: t1 key);

		destination: (nodeToMorph at: t1 value).
	t2 notNil
		ifTrue: [t5 := t2 asMorph.
			t5 align: t5 center with: t3 center.
			t3 addMorph: t5].
	self addMorphBack: t3.
	^ t3! !

!GraphLayoutMorph methodsFor: 'private'!
privateRemoveEdge: t1 label: t2
	| t3 |
	t3 := Array with: t1 key with: t1 value.
	(edgeToMorph includesKey: t3)
		ifFalse: [^ false].
	(edgeToMorph at: t3) delete.
	edgeToMorph removeKey: t3! !

!GraphLayoutMorph methodsFor: 'private'!
removeEdge: t1
	^ self removeEdge: t1 label: nil! !

!GraphLayoutMorph methodsFor: 'private'!
removeEdge: t1 label: t2
	^ self privateRemoveEdge: t1 label: t2! !

!GraphLayoutMorph methodsFor: 'layout'!
clearAll
	self clearEdges.
	self clearNodes! !

!GraphLayoutMorph methodsFor: 'layout'!
clearEdges
	self
		edgesDo: [:t1 | t1 delete].
	self initializeEdgeToMorph! !

!GraphLayoutMorph methodsFor: 'layout'!
clearNodes
	self
		nodesDo: [:t1 | t1 delete].
	self initializeNodeToMorph! !

!GraphLayoutMorph methodsFor: 'layout'!
redraw
	self graph: graph! !

!GraphLayoutMorph methodsFor: 'layout'!
toggleDebugging
	debug := debug not! !

!GraphLayoutMorph methodsFor: 'layout'!
toggleDraw
	draw := draw not! !

!GraphLayoutMorph methodsFor: 'layout'!
toggleMetrics
	metrics := metrics not! !

!GraphLayoutMorph methodsFor: 'testing'!
debugIsOn
	^ debug! !

!GraphLayoutMorph methodsFor: 'testing'!
drawIsOn
	^ draw! !

!GraphLayoutMorph methodsFor: 'testing'!
includesNode: t1
	^ nodeToMorph includesKey: t1! !

!GraphLayoutMorph methodsFor: 'testing'!
metricsIsOn
	^ metrics! !

!GraphLayoutMorph methodsFor: 'accessing'!
edgeClass
	self graph type = #(#ordered )
		ifTrue: [^ DirectedEdgeMorph].
	^ EdgeMorph! !

!GraphLayoutMorph methodsFor: 'accessing'!
focusNode
	^ focusNode! !

!GraphLayoutMorph methodsFor: 'accessing'!
focusOn: t1
	focusNode := t1! !

!GraphLayoutMorph methodsFor: 'accessing'!
graph
	^ graph! !

!GraphLayoutMorph methodsFor: 'accessing'!
graph: t1
	self removeAllMorphs.
	graph := t1.
	self drawIsOn
		ifTrue: [graph
				nodesDo: [:t2 | self addNode: t2].
			graph
				when: #addNode:
				send: #addNode:
				to: self.
			graph
				when: #addEdge:
				send: #addEdge:
				to: self.
			graph
				when: #removeNode:
				send: #removeNode:
				to: self.
			graph
				when: #removeEdge:
				send: #removeEdge:
				to: self.
			(graph isKindOf: RootedGraph)
				ifTrue: [self focusOn: graph rootNode]
				ifFalse: [self focusOn: graph anyNode]]! !

!GraphLayoutMorph methodsFor: 'accessing'!
nodeClass
	^ GraphNodeMorph! !

!GraphLayoutMorph methodsFor: 'accessing'!
nodeToMorph
	^ nodeToMorph! !

!GraphLayoutMorph methodsFor: 'accessing'!
origin
	^ (nodeToMorph
		at: (focusNode
				ifNil: [^ self center])) center! !

!GraphLayoutMorph methodsFor: 'enumerating'!
edgesDo: t1
	edgeToMorph do: t1! !

!GraphLayoutMorph methodsFor: 'enumerating'!
nodesDo: t1
	nodeToMorph do: t1! !

!GraphLayoutMorph methodsFor: 'initialization'!
initialize
	super initialize.
	self extent: 600 @ 600.
	self color: Color veryVeryLightGray.
	self borderColor: Color lightGray.
	self initializeNodeToMorph.
	self initializeEdgeToMorph.
	draw := true.
	metrics := false.
	debug := false! !

!GraphLayoutMorph methodsFor: 'initialization'!
initializeEdgeToMorph
	edgeToMorph := Dictionary new! !

!GraphLayoutMorph methodsFor: 'initialization'!
initializeNodeToMorph
	nodeToMorph := Dictionary new! !

GraphLayoutMorph subclass: #SpringsGraphMorph
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphs-Morphic-Graphs'!

!SpringsGraphMorph methodsFor: 'as yet unclassified'!
allowSubmorphExtraction
	^ true! !

!SpringsGraphMorph methodsFor: 'as yet unclassified'!
aproachConnectedNodes
	self
		edgesDo: [:t1 | t1 approachNodes; adjustBounds]! !

!SpringsGraphMorph methodsFor: 'as yet unclassified'!
edgeClass
	^ SpringEdgeMorph! !

!SpringsGraphMorph methodsFor: 'as yet unclassified'!
focusOn: t1
	super focusOn: t1.
	(nodeToMorph at: t1)
		dxdy: 0 @ 0.
	self startStepping! !

!SpringsGraphMorph methodsFor: 'as yet unclassified'!
graph: t1
	| t2 |
	super graph: t1.
	(t1 isKindOf: RootedGraph)
		ifTrue: [t2 := nodeToMorph at: t1 rootNode.
			t2 align: t2 center with: self center]! !

!SpringsGraphMorph methodsFor: 'as yet unclassified'!
nodeClass
	^ SpringsNodeMorph! !

!SpringsGraphMorph methodsFor: 'as yet unclassified'!
separateAllNodes
	self
		nodesDo: [:t1 | t1 separateFromAllNodes]! !

!SpringsGraphMorph methodsFor: 'as yet unclassified'!
step
	| t1 |
	t1 := 0.
	self
		nodesDo: [:t2 | t2 dxdy: t2 dxdy / 1.3].
	self aproachConnectedNodes; separateAllNodes.
	self
		nodesDo: [:t2 | t2 node == focusNode
				ifFalse: [t1 := t1 max: t2 doMove]].
	self changed.
	t1 < 2
		ifTrue: [self stopStepping]! !

!SpringsGraphMorph methodsFor: 'as yet unclassified'!
stepTime
	^ 0! !

GraphLayoutMorph subclass: #RadialGraphMorph
	instanceVariableNames: 'queue layoutTree dijkstra'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphs-Morphic-Graphs'!

!RadialGraphMorph methodsFor: 'as yet unclassified'!
cartesianToPolar: t1
	| t2 |
	t2 := t1 - self origin.
	^ t2 r @ t2 degrees! !

!RadialGraphMorph methodsFor: 'as yet unclassified'!
drawOn: t1
	| t2 t3 |
	super drawOn: t1! !

!RadialGraphMorph methodsFor: 'as yet unclassified'!
focusOn: t1
	| t2 |
	super focusOn: t1.
	queue := Set new: graph size.
	t2 := (self cartesianToPolar: (nodeToMorph at: t1) center) y.
	layoutTree := RootedGraph ordered.
	layoutTree
		roots: (Set with: t1).
	t1
		markDo: [:t3 | layoutTree add: t3].
	self
		moveNode: t1
		radius: 0
		angle: t2
		width: 360
		time: 600! !

!RadialGraphMorph methodsFor: 'as yet unclassified'!
graph: t1
	^ super graph: t1 symmetric! !

!RadialGraphMorph methodsFor: 'as yet unclassified'!
moveNode: t1 radius: t2 angle: t3 width: t4 time: t5
	| t6 t7 t8 t9 t10 |
	(queue includes: t1)
		ifTrue: [^ self].
	queue add: t1.
	t6 := nodeToMorph at: t1.
	t6
		moveToRadius: t2
		angle: t3
		time: t5.
	t8 := t1 outNeighbors copyWithoutAll: queue.
	t8 isEmpty
		ifTrue: [^ self].
	t9 := t4 / t8 size.
	t7 := t3 - (t4 / 2).
	t8
		do: [:t11 |
			t10 := t9.
			self
				moveNode: t11
				radius: t2 + self ringSeparation
				angle: t7 + (t10 / 2)
				width: t10
				time: t5.
			t7 := t7 + t10]! !

!RadialGraphMorph methodsFor: 'as yet unclassified'!
nodeClass
	^ RadialNodeMorph! !

!RadialGraphMorph methodsFor: 'as yet unclassified'!
numberOfRings
	^ 8! !

!RadialGraphMorph methodsFor: 'as yet unclassified'!
origin
	^ self center! !

!RadialGraphMorph methodsFor: 'as yet unclassified'!
polarToCartesian: t1
	^ (Point r: t1 x degrees: t1 y)
		+ self origin! !

!RadialGraphMorph methodsFor: 'as yet unclassified'!
ringSeparation
	^ (bounds width min: bounds height)
		// self numberOfRings! !

Graphs-Plot-Morph.st

Object subclass: #PlotMorphGrid
	instanceVariableNames: 'plot drawAxis drawGrid'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphs-Plot-Morph'!
!PlotMorphGrid commentStamp: '' prior: 0!
I'm the grid of a PlotMorph!

!PlotMorphGrid methodsFor: 'drawing' stamp: 'dgd 7/20/2002 16:31'!
bestStep: aNumber
	"answer the best step for grid drawing"
	| bestStep |
	bestStep := aNumber.
	2
		to: 40
		by: 2
		do: [:i |
			| step |
			step := aNumber / i.
			(step between: 25 and: 100)
				ifTrue: [bestStep := step]].
	^ bestStep! !

!PlotMorphGrid methodsFor: 'drawing' stamp: 'jcg 8/30/2003 13:06'!
drawAxisOn: aCanvas
	| axisColor yTo lighter darker baseColor bounds xTo |
	baseColor := plot baseColor alpha: 1.
	lighter := baseColor twiceLighter twiceLighter twiceLighter.
	darker := baseColor twiceDarker twiceDarker twiceDarker.
	axisColor := (lighter diff: baseColor)
					> (darker diff: baseColor)
				ifTrue: [lighter]
				ifFalse: [darker].
	""
	bounds := plot drawBounds.
	"Y axe"
	yTo := bounds topLeft - (0 @ 7).
	aCanvas
		line: bounds bottomLeft + (0 @ 5)
		to: yTo
		color: axisColor.
	aCanvas
		line: yTo
		to: yTo + (4 @ 4)
		color: axisColor.
	aCanvas
		line: yTo
		to: yTo + (-4 @ 4)
		color: axisColor.
	"X axe"
	xTo := bounds bottomRight + (7 @ 0).
	aCanvas
		line: bounds bottomLeft - (5 @ 0)
		to: xTo
		color: axisColor.
	aCanvas
		line: xTo
		to: xTo + (-4 @ -4)
		color: axisColor.
	aCanvas
		line: xTo
		to: xTo + (-4 @ 4)
		color: axisColor! !

!PlotMorphGrid methodsFor: 'drawing' stamp: 'FranciscoAryMartins 3/18/2012 16:15'!
drawGridOn: aCanvas
	| gridColor lighter darker baseColor bounds |
	baseColor := plot baseColor alpha: 1.
	lighter := baseColor twiceLighter.
	darker := baseColor twiceDarker.
	gridColor := (lighter diff: baseColor)
					> (darker diff: baseColor)
				ifTrue: [lighter]
				ifFalse: [darker].
	""
	bounds := plot drawBounds.
	(bounds left
		to: bounds right
		by: (self bestStep: bounds width))
		do: [:x | |xx|
			xx := x rounded.
			aCanvas
				line: xx @ bounds top
				to: xx @ bounds bottom
				color: gridColor].
	(bounds top
		to: bounds bottom
		by: (self bestStep: bounds height))
		do: [:y | |yy|
			yy := y rounded.
			aCanvas
				line: bounds left @ yy
				to: bounds right @ yy
				color: gridColor]! !

!PlotMorphGrid methodsFor: 'drawing' stamp: 'dgd 10/16/2001 14:45'!
drawOn: aCanvas
	drawGrid
		ifTrue: [self drawGridOn: aCanvas].
	drawAxis
		ifTrue: [self drawAxisOn: aCanvas]! !

!PlotMorphGrid methodsFor: 'accessing' stamp: 'dgd 10/16/2001 14:46'!
drawAxis: aBoolean
	drawAxis := aBoolean! !

!PlotMorphGrid methodsFor: 'accessing' stamp: 'dgd 10/16/2001 14:46'!
drawGrid: aBoolean
	drawGrid := aBoolean! !

!PlotMorphGrid methodsFor: 'initialization' stamp: 'dgd 10/16/2001 14:30'!
initialize
	drawAxis := true.
	drawGrid := true! !

!PlotMorphGrid methodsFor: 'initialization' stamp: 'dgd 10/16/2001 14:29'!
initializeOn: aPlotMorph
plot := aPlotMorph! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

PlotMorphGrid class
	instanceVariableNames: ''!

!PlotMorphGrid class methodsFor: 'instance creation' stamp: 'dgd 10/16/2001 14:30'!
new
	^ super new initialize! !

!PlotMorphGrid class methodsFor: 'instance creation' stamp: 'dgd 10/16/2001 14:29'!
on: aPlotMorph
	^ self new initializeOn: aPlotMorph! !

Object subclass: #PlotSeries
	instanceVariableNames: 'name description color width points drawPoints drawLine drawArea type'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphs-Plot-Morph'!
!PlotSeries commentStamp: '' prior: 0!
I'm a serie of a PlotMorph!

!PlotSeries methodsFor: 'points' stamp: 'DGD 6/13/2001 23:30'!
addPoint: aPoint
	points
		add: (PlotPoint at: aPoint serie: self)! !

!PlotSeries methodsFor: 'points' stamp: 'DGD 6/13/2001 23:31'!
addPoint: aPoint extra:anObject
	points
		add: (PlotPoint at: aPoint serie: self extra:anObject)! !

!PlotSeries methodsFor: 'points' stamp: 'dgd 10/15/2001 18:30'!
maxPoint
	^ points isEmpty
		ifTrue: [nil]
		ifFalse: [points max]! !

!PlotSeries methodsFor: 'points' stamp: 'dgd 10/15/2001 18:30'!
minPoint
	^ points isEmpty
		ifTrue: [nil]
		ifFalse: [points min]! !

!PlotSeries methodsFor: 'points' stamp: 'dgd 3/25/2003 09:41'!
scaleTo: anRectangle height: heightInteger maxPoint: maxPoint minPoint: minPoint
	| drawExtent scaleFrom scaleTo|
	drawExtent := 1 @ 1 max: maxPoint - minPoint.
	drawExtent isZero ifTrue:[^ self].
""

			scaleFrom := 0 @ 0 rect: drawExtent.
			scaleTo := anRectangle.
			points do:
					[:point |
					| tempPoint |
					tempPoint := point - minPoint scaleFrom: scaleFrom to: scaleTo.
					point scaledPoint: tempPoint x @ (heightInteger - tempPoint y)]! !

!PlotSeries methodsFor: 'accessing-color' stamp: 'dgd 7/20/2002 12:48'!
areaColor
	^ color alpha: 0.25! !

!PlotSeries methodsFor: 'accessing-color' stamp: 'DGD 6/14/2001 00:27'!
color: anObject
	color := anObject! !

!PlotSeries methodsFor: 'accessing-color' stamp: 'dgd 7/20/2002 12:49'!
lineColor
	^ color
		alpha: 0.85! !

!PlotSeries methodsFor: 'accessing-color' stamp: 'dgd 7/20/2002 12:47'!
pointColor
	^ color twiceLighter alpha: 0.85! !

!PlotSeries methodsFor: 'accessing' stamp: 'DGD 6/14/2001 00:53'!
clear
points := OrderedCollection new! !

!PlotSeries methodsFor: 'accessing' stamp: 'dgd 10/18/2001 12:54'!
color
	^color! !

!PlotSeries methodsFor: 'accessing' stamp: 'dgd 10/18/2001 14:31'!
description
	^ description ifNil:[name]! !

!PlotSeries methodsFor: 'accessing' stamp: 'dgd 10/18/2001 14:31'!
description: aString
	description := aString! !

!PlotSeries methodsFor: 'accessing' stamp: 'DGD 7/3/2001 16:32'!
drawArea: aBoolean
	drawArea := aBoolean! !

!PlotSeries methodsFor: 'accessing' stamp: 'DGD 7/5/2001 12:01'!
drawLine: aBoolean
	drawLine := aBoolean! !

!PlotSeries methodsFor: 'accessing' stamp: 'DGD 7/3/2001 16:32'!
drawPoints: aBoolean
	drawPoints := aBoolean! !

!PlotSeries methodsFor: 'accessing' stamp: 'DGD 6/14/2001 00:51'!
name
	^ name! !

!PlotSeries methodsFor: 'accessing' stamp: 'DGD 6/14/2001 00:20'!
points
	^points! !

!PlotSeries methodsFor: 'accessing' stamp: 'DGD 7/5/2001 12:33'!
type: aSymbol
	"Line Type (#straightened, #stepped)"
	type := aSymbol! !

!PlotSeries methodsFor: 'accessing' stamp: 'DGD 6/14/2001 01:19'!
width: anObject
	width := anObject! !

!PlotSeries methodsFor: 'drawing' stamp: 'dgd 10/15/2001 18:10'!
drawOn: aCanvas
	points isEmpty
		ifTrue: [^ self].
""
			drawArea
				ifTrue: [""
					type == #straightened
						ifTrue: [self drawStraightenedAreaOn: aCanvas].
					type == #stepped
						ifTrue: [self drawSteppedAreaOn: aCanvas]].
			drawLine
				ifTrue: [""
					type == #straightened
						ifTrue: [self drawStraightenedLineOn: aCanvas].
					type == #stepped
						ifTrue: [self drawSteppedLineOn: aCanvas]].
			drawPoints
				ifTrue: [self drawPointsOn: aCanvas]! !

!PlotSeries methodsFor: 'drawing' stamp: 'FranciscoAryMartins 3/18/2012 16:19'!
drawPointsOn: aCanvas
	| pointColor minus plus |
	pointColor := self pointColor.
	minus := width @ width.
	plus := minus * 2.
	points do: [:point |
			| scaledPoint |
			scaledPoint := point scaledPoint.
			aCanvas
				fillOval: (scaledPoint - minus rect: scaledPoint + plus)
				color: pointColor]! !

!PlotSeries methodsFor: 'drawing' stamp: 'dgd 10/15/2001 18:11'!
drawSteppedAreaOn: aCanvas
	| areaColor areaPoints lastScaledPoint |
			areaColor := self areaColor.
			areaPoints := OrderedCollection new.
			lastScaledPoint := nil.
			points
				do: [:each |
					| scaledPoint |
					scaledPoint := each scaledPoint.
					lastScaledPoint
						ifNotNil: [areaPoints add: scaledPoint x @ lastScaledPoint y].
					areaPoints add: scaledPoint.
					lastScaledPoint := scaledPoint].
			aCanvas
				drawPolygon: areaPoints
				color: areaColor
				borderWidth: 0
				borderColor: areaColor! !

!PlotSeries methodsFor: 'drawing' stamp: 'dgd 10/15/2001 17:48'!
drawSteppedLineOn: aCanvas
	| lineColor lastScaledPoint |
	lineColor := self lineColor.
	lastScaledPoint := nil.
	points
		do: [:point |
			| scaledPoint |
			scaledPoint := point scaledPoint.
			lastScaledPoint
				ifNotNil: [""aCanvas
						line: lastScaledPoint
						to: scaledPoint x @ lastScaledPoint y
						width: width
						color: lineColor.
					aCanvas
						line: scaledPoint x @ lastScaledPoint y
						to: scaledPoint
						width: width
						color: lineColor].
			lastScaledPoint := scaledPoint]! !

!PlotSeries methodsFor: 'drawing' stamp: 'dgd 10/15/2001 18:11'!
drawStraightenedAreaOn: aCanvas
	| areaColor |
			areaColor := self areaColor.
			aCanvas
				drawPolygon: (points
						collect: [:each | each scaledPoint])
				color: areaColor
				borderWidth: 0
				borderColor: areaColor! !

!PlotSeries methodsFor: 'drawing' stamp: 'dgd 10/15/2001 17:13'!
drawStraightenedLineOn: aCanvas
	| lineColor lastScaledPoint |
	lineColor := self lineColor.
	lastScaledPoint := nil.
	points
		do: [:point |
			| scaledPoint |
			scaledPoint := point scaledPoint.
			lastScaledPoint
				ifNotNil: [aCanvas
						line: lastScaledPoint
						to: scaledPoint
						width: width
						color: lineColor].
			lastScaledPoint := scaledPoint]! !

!PlotSeries methodsFor: 'initialization' stamp: 'dgd 7/20/2002 12:25'!
initializeName: aString
	name := aString.
	""
	color := Color black.

	""
	width := 1.
	drawPoints := true.
	drawLine := true.
	drawArea := false.
	type := #straightened.
	points := OrderedCollection new! !

!PlotSeries methodsFor: 'printing' stamp: 'DGD 7/5/2001 12:00'!
printOn: aStream
	aStream nextPutAll: 'Serie:';
		 nextPutAll: name;
		 nextPutAll: ', color:';
		 nextPutAll: color asString;
		 nextPutAll: ', width:';
		 nextPutAll: width asString;
		 nextPutAll: ', drawPoints:';
		 nextPutAll: drawPoints asString;
		 nextPutAll: ', drawLine:';
		 nextPutAll: drawLine asString;
		 nextPutAll: ', drawArea:';
		 nextPutAll: drawArea asString! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

PlotSeries class
	instanceVariableNames: ''!

!PlotSeries class methodsFor: 'instance creation' stamp: 'DGD 6/13/2001 23:45'!
name: aString
	^ self new
		initializeName: aString
		! !

Point subclass: #PlotPoint
	instanceVariableNames: 'series scaledPoint extra'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphs-Plot-Morph'!
!PlotPoint commentStamp: '' prior: 0!
PlotPoint is a point that have more data used to draw in a PlotMorph!

!PlotPoint methodsFor: 'comparing' stamp: 'dgd 10/11/2003 21:16'!
= anObject
	^ super = anObject
		and: [series = anObject series
				and: [extra = anObject extra]]! !

!PlotPoint methodsFor: 'comparing' stamp: 'dgd 10/11/2003 21:15'!
hash
	^ super hash
		bitXor: (series hash bitXor: extra hash)! !

!PlotPoint methodsFor: 'accessing' stamp: 'DGD 5/27/2001 23:29'!
extra
	^extra! !

!PlotPoint methodsFor: 'accessing' stamp: 'dgd 9/19/2001 22:58'!
scaledPoint
	^ scaledPoint ifNil:[self]! !

!PlotPoint methodsFor: 'accessing' stamp: 'DGD 5/27/2001 18:23'!
scaledPoint: anObject
	scaledPoint := anObject! !

!PlotPoint methodsFor: 'accessing' stamp: 'dgd 10/11/2003 21:16'!
series
	^ series! !

!PlotPoint methodsFor: 'initialization' stamp: 'DGD 5/28/2001 01:41'!
initialize
scaledPoint := self! !

!PlotPoint methodsFor: 'initialization' stamp: 'dgd 10/11/2003 21:16'!
initializeAt: aPoint series: aPlotSeries
	self setX: aPoint x setY: aPoint y.
	series := aPlotSeries! !

!PlotPoint methodsFor: 'initialization' stamp: 'dgd 10/11/2003 21:16'!
initializeAt: aPoint series: aPlotSeries extra: anObject
	self setX: aPoint x setY: aPoint y.
	series := aPlotSeries.
	extra := anObject! !

!PlotPoint methodsFor: 'printing' stamp: 'dgd 10/11/2003 21:16'!
printOn: aStream
	super printOn: aStream.
	aStream nextPutAll: ' series:(';
		 print: series;
		 nextPutAll: ') scaled:';
		 print: scaledPoint.
	extra isNil
		ifFalse: [aStream nextPutAll: ' extra:';
				 print: extra]! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

PlotPoint class
	instanceVariableNames: ''!

!PlotPoint class methodsFor: 'instance creation' stamp: 'dgd 10/11/2003 21:15'!
at: aPoint serie: aPlotSerie
	^ self new initializeAt: aPoint series: aPlotSerie! !

!PlotPoint class methodsFor: 'instance creation' stamp: 'DGD 6/13/2001 19:26'!
at: aPoint serie: aPlotSerie extra: anObject
	^ self new
		initializeAt: aPoint
		serie: aPlotSerie
		extra: anObject! !

!PlotPoint class methodsFor: 'instance creation' stamp: 'dgd 10/11/2003 21:14'!
at: aPoint series: aPlotSeries
	^ self new initializeAt: aPoint series: aPlotSeries! !

!PlotPoint class methodsFor: 'instance creation' stamp: 'dgd 10/11/2003 21:14'!
at: aPoint series: aPlotSeries extra: anObject
	^ self new
		initializeAt: aPoint
		series: aPlotSeries
		extra: anObject! !

!PlotPoint class methodsFor: 'instance creation' stamp: 'DGD 5/28/2001 01:41'!
new
^super new initialize! !

RectangleMorph subclass: #AxesMorph
	instanceVariableNames: 'form limitMaxX limitMinX limitMaxY limitMinY title xmax xmid xmin ymax ymid ymin xAxisFormatter yAxisFormatter margin grid drawCotas'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphs-Plot-Morph'!
!AxesMorph commentStamp: 'jcg 8/29/2003 23:01' prior: 0!
I am responsible for drawing a pair of axes, a grid, and various labels.  I am not responsible for the display of any data, or for handling user input in any special way.!

!AxesMorph methodsFor: 'accessing' stamp: 'jcg 8/30/2003 13:04'!
baseColor
	"Answer the base color to calculate other colors from"
	| baseColor current |

	baseColor := self color.
	current := self.
	[current notNil & (baseColor = Color transparent)]
		whileTrue: [""
			baseColor := current color.
			current := current owner].
	^ baseColor! !

!AxesMorph methodsFor: 'accessing' stamp: 'jcg 8/30/2003 11:50'!
color: aColor

	super color: aColor.
	self updateCotas! !

!AxesMorph methodsFor: 'accessing' stamp: 'jcg 8/31/2003 11:07'!
gridOrigin
	"Answer the intersection of the two axes (lower left corner of the grid)"
	| inset |

	inset := self borderWidth + margin.
	^ self bottomLeft + (inset @ inset negated)! !

!AxesMorph methodsFor: 'accessing' stamp: 'jcg 8/30/2003 11:49'!
limitMaxX: aNumberOrNil
 	"Set the maximum value along the X axis.  If nil, this value will be computed from the data points to be displayed (subclass responsibility, since AxesMorph doesn't know anything about data)."

	limitMaxX := aNumberOrNil.
	self changed.! !

!AxesMorph methodsFor: 'accessing' stamp: 'jcg 8/30/2003 11:49'!
limitMaxY: aNumberOrNil
 	"Set the maximum value along the X axis.  If nil, this value will be computed from the data points to be displayed (subclass responsibility, since AxesMorph doesn't know anything about data)."

	limitMaxY := aNumberOrNil.
	self changed! !

!AxesMorph methodsFor: 'accessing' stamp: 'jcg 8/30/2003 11:49'!
limitMinX: aNumberOrNil
 	"Set the maximum value along the X axis.  If nil, this value will be computed from the data points to be displayed (subclass responsibility, since AxesMorph doesn't know anything about data)."

	limitMinX := aNumberOrNil.
	self changed! !

!AxesMorph methodsFor: 'accessing' stamp: 'jcg 8/30/2003 11:49'!
limitMinY: aNumberOrNil
 	"Set the maximum value along the X axis.  If nil, this value will be computed from the data points to be displayed (subclass responsibility, since AxesMorph doesn't know anything about data)."

	limitMinY := aNumberOrNil.
	self changed! !

!AxesMorph methodsFor: 'accessing' stamp: 'jcg 8/30/2003 11:50'!
margin: anInteger
	"Set the size of the margin surrounding the grid."

	margin := anInteger.
	self changed! !

!AxesMorph methodsFor: 'accessing' stamp: 'jcg 8/30/2003 13:05'!
referenceColor
	"This name is confusing because it sounds like it has something to do with PlotMorphs 'references' instance variable."

	self deprecatedExplanation: 'use #baseColor instead'.
	^ self baseColor! !

!AxesMorph methodsFor: 'accessing' stamp: 'jcg 8/30/2003 11:46'!
shouldDrawAxis: aBoolean

	grid drawAxis: aBoolean.
	self changed! !

!AxesMorph methodsFor: 'accessing' stamp: 'jcg 8/30/2003 11:46'!
shouldDrawCotas: aBoolean
	aBoolean = drawCotas ifTrue: [^self].
	""
	drawCotas := aBoolean.
	title visible: aBoolean.
	xmax visible: aBoolean.
	xmid visible: aBoolean.
	xmin visible: aBoolean.
	ymax visible: aBoolean.
	ymid visible: aBoolean.
	ymin visible: aBoolean.
	""
	self changed! !

!AxesMorph methodsFor: 'accessing' stamp: 'jcg 8/30/2003 11:47'!
shouldDrawGrid: aBoolean

	grid drawGrid: aBoolean.
	self changed! !

!AxesMorph methodsFor: 'accessing' stamp: 'jcg 8/30/2003 11:50'!
title:aString

	title contents: aString! !

!AxesMorph methodsFor: 'accessing' stamp: 'jcg 8/29/2003 23:09'!
xAxisFormatter: aFormatterBlock

	xAxisFormatter := aFormatterBlock.
	self updateCotas! !

!AxesMorph methodsFor: 'accessing' stamp: 'jcg 8/29/2003 23:09'!
yAxisFormatter: aFormatterBlock

	yAxisFormatter := aFormatterBlock.
	self updateCotas! !

!AxesMorph methodsFor: 'change reporting' stamp: 'jcg 8/30/2003 11:54'!
changed

	super changed.
	form := nil.! !

!AxesMorph methodsFor: 'drawing' stamp: 'jcg 8/30/2003 13:03'!
cotaColor
	| baseColor lighter darker |
	baseColor := self baseColor asNontranslucentColor.
	baseColor = Color white
		ifTrue: [^ Color black].
	""
	lighter := baseColor muchLighter.
	darker := baseColor muchDarker.
	""
	^ (lighter diff: baseColor) > (darker diff: baseColor)
		ifTrue: [lighter]
		ifFalse: [darker]! !

!AxesMorph methodsFor: 'drawing' stamp: 'FranciscoAryMartins 3/18/2012 16:14'!
drawGridOn: aCanvas
	| gridColor right bottom width height lighter darker baseColor |
	baseColor := self baseColor.
	lighter := baseColor twiceLighter.
	darker := baseColor twiceDarker.
	gridColor := (lighter diff: baseColor)
				> (darker diff: baseColor) ifTrue: [lighter] ifFalse: [darker].
	""
	right := self bounds width - margin.
	width := self bounds width - (margin * 2).
	bottom := self bounds height - margin.
	height := self bounds height - (margin * 2).
	(margin to: right by: width / 10) do:
			[:x | | xx |
			xx := x rounded.
			aCanvas
				line: xx @ margin
				to: xx @ bottom
				color: gridColor].
	(margin to: bottom by: height / 10) do:
			[:y | |yy|
			yy := y rounded.
			aCanvas
				line: margin @ yy
				to: right @ yy
				color: gridColor]! !

!AxesMorph methodsFor: 'drawing' stamp: 'jcg 8/30/2003 12:42'!
drawOn: aCanvas
	super drawOn: aCanvas.
	aCanvas
		image: self form
		at: self topLeft + self borderWidth
		rule: Form blend! !

!AxesMorph methodsFor: 'drawing' stamp: 'jcg 8/30/2003 12:38'!
form

	form ifNil: [
		Cursor wait showWhile: [
			form := Form
						extent: (self bounds insetBy: self borderWidth) extent
						depth: Display depth.
			form fillColor: self color.
			self updateForm]].
	^ form! !

!AxesMorph methodsFor: 'drawing' stamp: 'jcg 8/30/2003 12:32'!
maxPoint
	"Limit values must be non-nil"

	^ limitMaxX @ limitMaxY! !

!AxesMorph methodsFor: 'drawing' stamp: 'jcg 8/30/2003 12:32'!
minPoint
	"Limit values must be non-nil"

	^ limitMinX @ limitMinY! !

!AxesMorph methodsFor: 'drawing' stamp: 'jcg 8/30/2003 12:42'!
updateCotas

	| cotaColor |
	xmax isNil
		ifTrue: [^ self].
	""
	cotaColor := self cotaColor.
	title color: cotaColor.
	xmax color: cotaColor.
	xmid color: cotaColor.
	xmin color: cotaColor.
	ymax color: cotaColor.
	ymid color: cotaColor.
	ymin color: cotaColor.
	""
	xmax
		contents: (xAxisFormatter value: self maxPoint x).
	xmid
		contents: (xAxisFormatter value: self maxPoint x + self minPoint x / 2).
	xmin
		contents: (xAxisFormatter value: self minPoint x).
	ymax
		contents: (yAxisFormatter value: self maxPoint y).
	ymid
		contents: (yAxisFormatter value: self maxPoint y + self minPoint y / 2).
	ymin
		contents: (yAxisFormatter value: self minPoint y).
	""
	title position: self topLeft + ((self width - title width / 2) rounded @ 0) + (0 @ self borderWidth).
	""
	xmax position: self topLeft + (self width - xmax width @ (self height - xmax height)) - (margin @ self borderWidth).
	xmid position: self topLeft + ((self width - xmid width / 2) rounded @ (self height - xmid height)) - (0 @ self borderWidth).
	xmin position: self topLeft + (0 @ (self height - xmin height)) + (margin @ 0) - (0 @ self borderWidth).
	""
	ymax position: self topLeft + ((0 - ymax width max: 0)
				@ 0) + (self borderWidth @ margin).
	ymid position: self topLeft + ((15 - ymid width max: 0)
				@ (self height - ymid height / 2) rounded) + (self borderWidth @ 0).
	ymin position: self topLeft + ((0 - ymin width max: 0)
				@ (self height - ymin height)) - (0 @ margin) + (self borderWidth @ 0)! !

!AxesMorph methodsFor: 'drawing' stamp: 'jcg 8/30/2003 12:40'!
updateForm

	self updateCotas.
	grid drawOn: form getCanvas.! !

!AxesMorph methodsFor: 'utility' stamp: 'jcg 8/31/2003 12:36'!
dataPointToGridPoint: aPoint
	"Compute the pixel coordinates wrt the grid origin of the given data point."
	| drawBounds |

	drawBounds := self drawBounds.
	^ (aPoint - self minPoint) * (drawBounds width @ drawBounds height negated).
! !

!AxesMorph methodsFor: 'utility' stamp: 'jcg 8/31/2003 12:38'!
dataPointToWorldPoint: aPoint
	"Compute the pixel coordinates wrt the World origin of the given data point."

	^ (self dataPointToGridPoint: aPoint) + self gridOrigin! !

!AxesMorph methodsFor: 'utility' stamp: 'jcg 8/31/2003 12:32'!
gridPointToDataPoint: aPoint
	"Compute the coordinates of the data point corresponding to the given grid point (given in pixel coordinates wrt the grid origin)."
	| drawBounds |

	drawBounds := self drawBounds.
	^ (aPoint x @ aPoint y negated) / (drawBounds extent) + self minPoint
! !

!AxesMorph methodsFor: 'utility' stamp: 'jcg 8/31/2003 12:35'!
worldPointToDataPoint: aPoint
	"Compute the pixel coordinates of the given data point wrt the World origin."

	^ self gridPointToDataPoint: aPoint - self gridOrigin
	! !

!AxesMorph methodsFor: 'geometry' stamp: 'jcg 8/30/2003 15:58'!
drawBounds
	"answer the rectangle inside the morph where the plot is drawn"
	^ (0 @ 0 rect: self width @ self height - (self borderWidth * 2))
		insetBy: margin! !

!AxesMorph methodsFor: 'geometry' stamp: 'jcg 8/30/2003 15:58'!
extent: aPoint
	super
		extent: (aPoint max: self minExtent)! !

!AxesMorph methodsFor: 'geometry' stamp: 'jcg 8/30/2003 15:58'!
minExtent
	^ 125 @ 125 + margin ! !

!AxesMorph methodsFor: 'naming' stamp: 'jcg 8/30/2003 16:01'!
externalName
	^ super externalName, (title contents isEmpty ifTrue:[''] ifFalse:[' - ', title contents])! !

!AxesMorph methodsFor: 'initialization' stamp: 'jcg 8/30/2003 16:03'!
initialize

	super initialize.

	self color: Color gray.
	grid := PlotMorphGrid on: self.

	xAxisFormatter := [:x | x printString].
	yAxisFormatter := [:y | y printString].
	self initializeCotas.
	margin := 15 max: (title height + 2).
	form := nil.
	self extent: 1@1.! !

!AxesMorph methodsFor: 'initialization' stamp: 'jcg 8/30/2003 15:50'!
initializeCotas
	drawCotas := true.
	""
	title := StringMorph contents: '' font: TextStyle defaultFont emphasis: 1.
	xmax := StringMorph contents: ''.
	xmid := StringMorph contents: ''.
	xmin := StringMorph contents: ''.
	ymax := StringMorph contents: ''.
	ymid := StringMorph contents: ''.
	ymin := StringMorph contents: ''.
	""
	self addMorph: title.
	self addMorph: xmax.
	self addMorph: xmid.
	self addMorph: xmin.
	self addMorph: ymax.
	self addMorph: ymid.
	self addMorph: ymin.
	""
	limitMinX := 0.
	limitMaxX := 1.0.
	limitMinY := 0.
	limitMaxY := 1.0.! !

AxesMorph subclass: #PlotMorph
	instanceVariableNames: 'series cachedMaxPoint cachedMinPoint lens scaledPoints references processMouseDown balloonFormatter'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphs-Plot-Morph'!
!PlotMorph commentStamp: 'dgd 10/11/2003 21:12' prior: 0!
I can draw many series of Points in a XY grid.  See the methods testXXX in the class side.

Samples:

   PlotMorph test.
   PlotMorph test2.
   PlotMorph test4.
   PlotMorph testWithReferences.
!

!PlotMorph methodsFor: 'accessing' stamp: 'jcg 8/30/2003 16:04'!
balloonFormatter: anObject
	balloonFormatter := anObject! !

!PlotMorph methodsFor: 'accessing' stamp: 'gs 12/2/2001 11:40'!
cleanSeries
	| cleanSeries |
	cleanSeries := Dictionary new.
	series
		keysAndValuesDo: [:key :serie | cleanSeries
				at: key
				put: (serie points
						collect: [:plotPoint | plotPoint x @ plotPoint y])].
	^ cleanSeries! !

!PlotMorph methodsFor: 'accessing' stamp: 'DGD 6/14/2001 00:53'!
clear
	series do:[:each | each clear].
	self seriesChanged! !

!PlotMorph methodsFor: 'accessing' stamp: 'dgd 10/18/2001 16:57'!
processMouseDown: aBoolean
	processMouseDown := aBoolean! !

!PlotMorph methodsFor: 'accessing' stamp: 'jcg 8/29/2003 22:53'!
references: aMorphOrNil
	"Specifies a morph (if not nil) that is updated with the names of the plotted series, displayed in the same color as the actual plot."

	references := aMorphOrNil! !

!PlotMorph methodsFor: 'accessing' stamp: 'gs 11/30/2001 02:51'!
series
	^series! !

!PlotMorph methodsFor: 'change reporting' stamp: 'jcg 8/30/2003 11:54'!
changed

	cachedMaxPoint := nil.
	cachedMinPoint := nil.
	super changed! !

!PlotMorph methodsFor: 'deprecated' stamp: 'jcg 8/29/2003 22:46'!
drawAxis: aBoolean

	self deprecatedExplanation: 'use #shouldDrawAxis: instead'.
	self shouldDrawAxis: aBoolean! !

!PlotMorph methodsFor: 'deprecated' stamp: 'jcg 8/29/2003 22:46'!
drawCotas: aBoolean

	self deprecatedExplanation: 'use #shouldDrawCotas: instead'.
	self shouldDrawCotas: aBoolean! !

!PlotMorph methodsFor: 'deprecated' stamp: 'jcg 8/29/2003 22:46'!
drawGrid: aBoolean

	self deprecatedExplanation: 'use #shouldDrawGrid: instead'.
	self shouldDrawGrid: aBoolean! !

!PlotMorph methodsFor: 'deprecated' stamp: 'jcg 8/29/2003 16:38'!
serie: aSeriesOrSymbol

	self deprecatedExplanation: 'use #series: instead'.
	^ self series: aSeriesOrSymbol! !

!PlotMorph methodsFor: 'deprecated' stamp: 'jcg 8/29/2003 16:39'!
serie: aSymbol addPoint: aPoint

	self deprecatedExplanation: 'use #series:addPoint: instead'.
	^ self series: aSymbol addPoint: aPoint! !

!PlotMorph methodsFor: 'deprecated' stamp: 'jcg 8/29/2003 16:40'!
serie: aSymbol addPoint: aPoint extra: anObject

	self deprecatedExplanation: 'use #series:addPoint:extra: instead'.
	^ self series: aSymbol addPoint: aPoint extra: anObject! !

!PlotMorph methodsFor: 'deprecated' stamp: 'jcg 8/29/2003 16:41'!
serie: aSymbol color: aColor

	self deprecatedExplanation: 'use #series:color: instead'.
	^ self series: aSymbol color: aColor! !

!PlotMorph methodsFor: 'deprecated' stamp: 'jcg 8/29/2003 16:41'!
serie: aSymbol description: aString

	self deprecatedExplanation: 'use #series:description: instead'.
	^ self series: aSymbol description: aString! !

!PlotMorph methodsFor: 'deprecated' stamp: 'jcg 8/29/2003 16:41'!
serie: aSymbol drawArea: aBoolean

	self deprecatedExplanation: 'use #series:drawArea: instead'.
	^ self series: aSymbol drawArea: aBoolean! !

!PlotMorph methodsFor: 'deprecated' stamp: 'jcg 8/29/2003 16:41'!
serie: aSymbol drawLine: aBoolean

	self deprecatedExplanation: 'use #series:drawLine: instead'.
	^ self series: aSymbol drawLine: aBoolean! !

!PlotMorph methodsFor: 'deprecated' stamp: 'jcg 8/29/2003 16:42'!
serie: aSymbol drawPoints: aBoolean

	self deprecatedExplanation: 'use #series:drawPoints: instead'.
	^ self series: aSymbol drawPoints: aBoolean! !

!PlotMorph methodsFor: 'deprecated' stamp: 'jcg 8/29/2003 21:00'!
serie: aSymbol type: lineTypeSymbol

	self deprecatedExplanation: 'use #series:type: instead'.
	^ self series: aSymbol type: lineTypeSymbol! !

!PlotMorph methodsFor: 'deprecated' stamp: 'jcg 8/29/2003 21:00'!
serie: aSymbol width: anInteger

	self deprecatedExplanation: 'use #series:width: instead'.
	^ self series: aSymbol width: anInteger! !

!PlotMorph methodsFor: 'deprecated' stamp: 'jcg 8/29/2003 23:08'!
xAxeFormatter: aFormatterBlock

	self deprecatedExplanation: 'use #xAxisFormatter: instead'.
	self xAxisFormatter: aFormatterBlock! !

!PlotMorph methodsFor: 'deprecated' stamp: 'jcg 8/29/2003 23:08'!
yAxeFormatter: aFormatterBlock

	self deprecatedExplanation: 'use #yxAxisFormatter: instead'.
	self yAxisFormatter: aFormatterBlock! !

!PlotMorph methodsFor: 'private' stamp: 'DGD 6/28/2001 14:50'!
exploreExtrasAt: nearPoint
	| extras |
	extras := (self scaledPoints at: nearPoint)
				collect: [:each | each extra].
	extras := extras
				select: [:each | each notNil].

extras isEmpty ifFalse:[
	extras explore]! !

!PlotMorph methodsFor: 'private' stamp: 'DGD 6/14/2001 00:04'!
findNearestPointTo: targetPoint
	| nearestPoint |
	nearestPoint := nil.
	Cursor wait
				showWhile: [""
					self scaledPoints
						keysDo: [:scaledPoint | ""
							(nearestPoint isNil
									or: [(targetPoint dist: scaledPoint)
											< (targetPoint dist: nearestPoint)])
								ifTrue: [nearestPoint := scaledPoint]]].
	^ nearestPoint! !

!PlotMorph methodsFor: 'private' stamp: 'dgd 3/25/2003 09:09'!
seriesChanged
	cachedMaxPoint := nil.
	cachedMinPoint := nil.
	"If the morphs has no owner, then the morph is not open yet"
	owner isNil
ifTrue:[^ self].
""
	self changed.
	self updateCotas! !

!PlotMorph methodsFor: 'private' stamp: 'DGD 6/30/2001 13:34'!
showLensAt: nearPoint
	lens := EllipseMorph new.
	lens
		color: (Color red alpha: 0.5).
	lens extent: 7 @ 7.
	self addMorph: lens.
	lens position: self topLeft + nearPoint - (3 @ 3) + self borderWidth.
	lens
		showBalloon: (balloonFormatter
				value: (self scaledPoints at: nearPoint))! !

!PlotMorph methodsFor: 'private' stamp: 'dgd 10/11/2003 21:16'!
textForBalloon: aCollection
	| stream point |
	point := aCollection anyOne.
	stream := String new writeStream.
	stream
		nextPutAll: (xAxisFormatter value: point x);
		 nextPutAll: '  ';

		nextPutAll: (yAxisFormatter value: point y);
		 nextPut: Character cr.
	aCollection
		do: [:each |
			stream nextPutAll: each series name.
			each extra
				ifNotNil: [stream nextPutAll: ': ';
						 print: each extra]]
		separatedBy: [stream nextPut: Character cr].
	^ stream contents! !

!PlotMorph methodsFor: 'event handling' stamp: 'dgd 10/18/2001 16:53'!
handlesMouseDown: evt
	^ processMouseDown! !

!PlotMorph methodsFor: 'event handling' stamp: 'dgd 7/20/2002 16:08'!
mouseDown: anEvent
	| nearPoint |
	nearPoint := self findNearestPointTo: anEvent position - self topLeft - self borderWidth.
	nearPoint
		ifNotNil: [anEvent redButtonChanged
				ifTrue: [self showLensAt: nearPoint]
				ifFalse: [self exploreExtrasAt: nearPoint]]! !

!PlotMorph methodsFor: 'event handling' stamp: 'dgd 3/25/2003 09:09'!
mouseUp: anEvent
	lens isNil ifTrue:[^ self].
""

			lens deleteBalloon.
			lens delete.
			lens := nil! !

!PlotMorph methodsFor: 'initialization' stamp: 'jcg 8/30/2003 16:03'!
initialize
	super initialize.

	series := Dictionary new.
	processMouseDown := true.
	lens := nil.
	balloonFormatter := [:aCollection | self textForBalloon: aCollection].
	self extent: 1 @ 1! !

!PlotMorph methodsFor: 'initialization' stamp: 'jcg 8/30/2003 15:52'!
initializeCotas
	"Don't put initial limits on the grid range... default is to compute them from series data."

	super initializeCotas.
	limitMinX := limitMaxX := limitMinY := limitMaxY := nil.! !

!PlotMorph methodsFor: 'drawing' stamp: 'dgd 11/2/2001 17:31'!
maxPoint
	cachedMaxPoint
		ifNil: [""
			limitMaxX notNil & limitMaxY notNil
				ifTrue: [cachedMaxPoint := limitMaxY @ limitMaxY]
				ifFalse: [| maxPoints |
					maxPoints := series
								collect: [:serie | serie maxPoint]
								thenSelect: [:point | point notNil].
					cachedMaxPoint := maxPoints isEmpty
								ifTrue: [1 @ 1]
								ifFalse: [maxPoints max].
					limitMaxX notNil
						ifTrue: [cachedMaxPoint := limitMaxX @ cachedMaxPoint y].
					limitMaxY notNil
						ifTrue: [cachedMaxPoint := cachedMaxPoint x @ limitMaxY]]].
	^ cachedMaxPoint! !

!PlotMorph methodsFor: 'drawing' stamp: 'dgd 11/2/2001 17:15'!
minPoint
	cachedMinPoint
		ifNil: [""
			limitMinX notNil & limitMinY notNil
				ifTrue: [cachedMinPoint := limitMinX @ limitMinY]
				ifFalse: [| minPoints |
					minPoints := series
								collect: [:serie | serie minPoint]
								thenSelect: [:point | point notNil].
					cachedMinPoint := minPoints isEmpty
								ifTrue: [0 @ 0]
								ifFalse: [minPoints min].
					limitMinX notNil
						ifTrue: [cachedMinPoint :=  limitMinX
										@ cachedMinPoint y].
					limitMinY notNil
						ifTrue: [cachedMinPoint := cachedMinPoint x
										@ limitMinY]]].
	^ cachedMinPoint! !

!PlotMorph methodsFor: 'drawing' stamp: 'dgd 7/14/2002 16:24'!
scalePoints
	| |
	scaledPoints := nil.
	series
		do: [:serie | serie
				scaleTo: self drawBounds
				height: self height - (self borderWidth * 2)
				maxPoint: self maxPoint
				minPoint: self minPoint]! !

!PlotMorph methodsFor: 'drawing' stamp: 'DGD 6/13/2001 23:58'!
scaledPoints
	^ scaledPoints
		ifNil: [scaledPoints := Dictionary new.
			series
				do: [:serie | serie points
						do: [:point |
							| allPoints |
							allPoints := scaledPoints
										at: point scaledPoint
										ifAbsentPut: [OrderedCollection new].
							allPoints add: point]].
			scaledPoints]! !

!PlotMorph methodsFor: 'drawing' stamp: 'jcg 8/30/2003 16:06'!
updateForm
	"Override superclass implementation to do drawing of data."
	| canvas |

	self updateReferences.
	self updateCotas.
	self scalePoints.
	canvas := form getCanvas.
	grid drawOn: canvas.
	(series values
		asSortedCollection: [:x :y | x name 		do: [:serie | serie drawOn: canvas].
! !

!PlotMorph methodsFor: 'drawing' stamp: 'jcg 8/29/2003 22:55'!
updateReferences
	"Update a 'legend' displaying the description of each plotted series in the same color as that series."
	| seriesWithDescription sortedSeried |
	references isNil
		ifTrue: [^ self].
	""
	references removeAllMorphs.
""
	seriesWithDescription := series
				reject: [:each | each description isEmpty].
	sortedSeried := seriesWithDescription
				asSortedCollection: [:x :y | x description asLowercase 	sortedSeried
		do: [:serie |
			| ref |
			ref := StringMorph new.
			ref contents: serie description.
			ref color: serie color.
			references addMorphBack: ref.
			serie]! !

!PlotMorph methodsFor: 'series' stamp: 'jcg 8/29/2003 22:33'!
series: aSeriesOrSymbol
	"If aSeriesOrSymbol is a PlotSeries, simply answer it.  Otherwise, it should be a string, and the returned value is the series with that name."

	^ aSeriesOrSymbol isString
		ifTrue: [| symbol |
			symbol := aSeriesOrSymbol asSymbol.
			series
				at: symbol
				ifAbsentPut: [PlotSeries name: symbol]]
		ifFalse: [aSeriesOrSymbol]! !

!PlotMorph methodsFor: 'series' stamp: 'jcg 8/29/2003 22:34'!
series: aSymbol addPoint: aPoint
	"Find the appropriate series and set a property in it."

	(self series: aSymbol)
		addPoint: aPoint.
	self changed! !

!PlotMorph methodsFor: 'series' stamp: 'jcg 8/29/2003 22:34'!
series: aSymbol addPoint: aPoint extra: anObject
	"Find the appropriate series and set a property in it."

	(self series: aSymbol)
		addPoint: aPoint
		extra: anObject.
	self changed ! !

!PlotMorph methodsFor: 'series' stamp: 'jcg 8/29/2003 22:35'!
series: aSymbol color: aColor
	"Find the appropriate series and set a property in it."

	(self series:aSymbol) color:aColor.
	self changed! !

!PlotMorph methodsFor: 'series' stamp: 'jcg 8/29/2003 22:35'!
series: aSymbol description: aString
	"Find the appropriate series and set a property in it."

	(self series: aSymbol)
		description: aString.
	self changed! !

!PlotMorph methodsFor: 'series' stamp: 'jcg 8/29/2003 22:35'!
series: aSymbol drawArea: aBoolean
	"Find the appropriate series and set a property in it."

	(self series: aSymbol)
		drawArea: aBoolean.
	self changed! !

!PlotMorph methodsFor: 'series' stamp: 'jcg 8/29/2003 22:35'!
series: aSymbol drawLine: aBoolean
	"Find the appropriate series and set a property in it."

	(self series: aSymbol)
		drawLine: aBoolean.
	self changed! !

!PlotMorph methodsFor: 'series' stamp: 'jcg 8/29/2003 22:35'!
series: aSymbol drawPoints: aBoolean
	"Find the appropriate series and set a property in it."

	(self series: aSymbol)
		drawPoints: aBoolean.
	self changed! !

!PlotMorph methodsFor: 'series' stamp: 'jcg 8/29/2003 22:35'!
series: seriesSymbol type: lineTypeSymbol
	"Find the appropriate series and set a property in it."

	(self series: seriesSymbol)
		type: lineTypeSymbol.
	self changed! !

!PlotMorph methodsFor: 'series' stamp: 'jcg 8/29/2003 22:35'!
series: aSymbol width: anInteger
	"Find the appropriate series and set a property in it."

	(self series: aSymbol) width: anInteger.
	self changed! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

PlotMorph class
	instanceVariableNames: ''!

!PlotMorph class methodsFor: 'instance creation' stamp: 'dgd 10/11/2003 21:16'!
plotPoints: aPointOrderedCollection
	| plotMorph |
	plotMorph := PlotMorph new.
	plotMorph color: Color black twiceLighter twiceLighter;
		 title: 'Colors';
		 extent: 700 @ 300;
		 useRoundedCorners;
		 borderRaised.
	plotMorph series: #series color: Color white;
		 series: #series drawLine: false.
	aPointOrderedCollection
		do: [:e | ""
			plotMorph series: #series addPoint: e].
	plotMorph openInWorld.
	^ plotMorph! !

!PlotMorph class methodsFor: 'instance creation' stamp: 'dgd 10/11/2003 21:16'!
plotSeries: aPointOrderedCollection
	| plotMorph |
	plotMorph := PlotMorph new.
	plotMorph color: Color gray lighter;
		 title: 'Colors';
		 extent: 700 @ 300;
		 useRoundedCorners;
		 borderRaised.
	plotMorph series: #series color: Color red;
		 series: #series drawLine: false.
	aPointOrderedCollection
		do: [:e | ""
			plotMorph series: #series addPoint: e].
	plotMorph openInWorld.
	^ plotMorph! !

!PlotMorph class methodsFor: 'deprecated' stamp: 'jcg 8/29/2003 16:35'!
plotSerie: aPointOrderedCollection

	self deprecatedExplanation: 'use #plotSeries: instead'.
	^ self plotSeries: aPointOrderedCollection! !

!PlotMorph class methodsFor: 'testing' stamp: 'jcg 8/29/2003 23:10'!
test
	"
	PlotMorph test
	"
	| pm |
	pm := PlotMorph new.
	pm
		color: (Color
				r: 0.0
				g: 0.376
				b: 0.317);
		 extent: 320 @ 320;
		 borderWidth: 2;
		 useRoundedCorners;
		 setBorderStyle: #raised;
		 title: 'Some test functions'.
	pm series: #sin color: Color red;
		 series: #cos color: Color blue;
		 series: #test color: Color yellow.
	pm series: #sin drawArea: true;
		 series: #cos drawArea: true;
		 series: #test drawArea: true.
	pm series: #sin description: 'sin';
		 series: #cos description: 'cosin';
		 series: #test description: 'test'.
	pm series: #test type: #stepped.
	pm series: #sin width: 2;
		 series: #sin drawLine: false.
	""
	pm
		yAxisFormatter: [:y | (y roundTo: 0.1) asString].
	""
	0
		to: 360
		by: 10
		do: [:x |
			pm series: #sin addPoint: x @ x degreesToRadians sin.
			pm series: #cos addPoint: x @ x degreesToRadians cos.
			pm series: #test addPoint: x @ (x degreesToRadians cos + x degreesToRadians sin)].
	""
	pm openInWorld! !

!PlotMorph class methodsFor: 'testing' stamp: 'jcg 8/29/2003 23:11'!
test2
	"
	PlotMorph test2
	"
	| pm sigmoid |
	pm := PlotMorph new.
	pm title: 'Sigmoid';
		 extent: 250 @ 250;
		 color: Color black.
	""
	pm series: #sigmoid1 color: Color red;
		 series: #sigmoid1 drawPoints: false;
		 series: #sigmoid2 color: Color blue;
		 series: #sigmoid2 drawPoints: false;
		 series: #sigmoid3 color: Color yellow;
		 series: #sigmoid3 drawPoints: false;
		 series: #sigmoid4 color: Color green;
		 series: #sigmoid4 drawPoints: false;
		 series: #sigmoid5 color: Color white;
		 series: #sigmoid5 drawPoints: false.
	""
	pm
		yAxisFormatter: [:y | (y roundTo: 0.1) asString].
	sigmoid := [:x :slope | 1 / (1 + (slope * x) negated exp)].
	-10
		to: 10
		by: 0.25
		do: [:x |
			pm series: #sigmoid1 addPoint: x
					@ (sigmoid value: x value: 3).
			pm series: #sigmoid2 addPoint: x
					@ (sigmoid value: x value: 2).
			pm series: #sigmoid3 addPoint: x
					@ (sigmoid value: x value: 1).
			pm series: #sigmoid4 addPoint: x
					@ (sigmoid value: x value: 1 / 2).
			pm series: #sigmoid5 addPoint: x
					@ (sigmoid value: x value: 1 / 3)].
	pm openInWorld! !

!PlotMorph class methodsFor: 'testing' stamp: 'jcg 8/29/2003 23:11'!
test4
	"
	PlotMorph test4
	"
	| pm function |
	pm := PlotMorph new.
	pm
		color: (Color blue twiceDarker twiceDarker twiceDarker alpha: 0.3);
		 extent: 300 @ 300;
		 useRoundedCorners.
	pm
		xAxisFormatter: [:x | x rounded asStringWithCommas].
	pm
		yAxisFormatter: [:y | y rounded asString].
	pm title: 'Some funny function'.
	pm series: #test2 color: Color red;
		 series: #test2 drawPoints: false.
	function := [:x | x degreesToRadians sin / 5 + ((x / 10) degreesToRadians cos + (x / 10) degreesToRadians sin) * 100].
	0
		to: 3000
		by: 5
		do: [:x | pm series: #test2 addPoint: x
					@ (function value: x)].
	pm openInWorld! !

!PlotMorph class methodsFor: 'testing' stamp: 'jcg 8/29/2003 15:15'!
testWithReferences
	"
	PlotMorph testWithReferences.
	"
	| pm ref |
	ref := AlignmentMorph newColumn.
	ref color: Color magenta twiceDarker twiceDarker;
		 hResizing: #shrinkWrap;
		 vResizing: #shrinkWrap;
		 wrapCentering: #center;
		 cellPositioning: #leftCenter.
	""
	pm := PlotMorph new.
	pm references: ref.
	pm color: Color magenta twiceDarker twiceDarker;
		 extent: 300 @ 300;
		 borderWidth: 0;
		 title: 'Some test functions'.
	pm series: #sin color: Color red;
		 series: #cos color: Color blue;
		 series: #test color: Color yellow.
	pm series: #sin drawArea: true;
		 series: #cos drawArea: true;
		 series: #test drawArea: true.
	pm series: #sin description: 'sin';
		 series: #cos description: 'cosin';
		 series: #test description: 'test'.
	pm series: #test type: #stepped.
	0
		to: 360
		by: 10
		do: [:x |
			pm series: #sin addPoint: x @ x degreesToRadians sin.
			pm series: #cos addPoint: x @ x degreesToRadians cos.
			pm series: #test addPoint: x @ (x degreesToRadians cos + x degreesToRadians sin)].
	""
	ref openInWorld.
	pm openInWorld! !

Testei alguns métodos de exemplo. Os que dependem de Morphs não funcionam bem no Pharo.

Como a documentação é praticamente nula tentei montar alguns exemplos para entender como funciona a biblioteca.

Para construir um grafo como o da figura abaixo

o código é o seguinte:

Inspecionando o grafo resultante temos:

Para ter acesso à estrutura do grafo usamos as mensagens Graph>>#nodes, Graph>>#edges, ExplicitGraphNode>>#inNeighbors e ExplicitGraphNode>>#outNeighbors.

Open Cobalt, sucessor do Croquet Project

O Croquet Project está inativo desde 2007. Os esforços foram transferidos, parece, para o Open Cobalt.

Veja o excerto tirado da Wikipedia:

Open Cobalt is a free and open source software platform for constructing, accessing, and sharing virtual world both on local area networks or across the Internet, without any requirement for centralized servers.

The technology makes it easy to create deeply collaborative and hyperlinked multi-user virtual workspaces, virtual exhibit spaces, and game-based learning and training environments that run on all major software operating systems. By using a peer-based messaging protocol to reduce reliance on server infrastructures for support of basic in world interactions across many participants, Open Cobalt makes it possible for people to hyperlink their virtual worlds via 3D portals to form a large distributed network of interconnected collaboration spaces. It also makes it possible for schools and other organizations to freely set up their own networks of public and private 3D virtual workspaces that feature integrated web browsingvoice chat,text chat and access to remote desktop applications and services.

ESUG é aceita na GSoC

Conditional halt

#haltIf:


haltIf: condition

	"This is the typical message to use for inserting breakpoints during

	debugging.  Param can be a block or expression, halt if true.

	If the Block has one arg, the receiver is bound to that.

 	If the condition is a selector, we look up in the callchain. Halt if

      any method's selector equals selector."

	| cntxt |

	condition isSymbol ifTrue:[

		"only halt if a method with selector symbol is in callchain"

		cntxt := thisContext.

		[cntxt sender isNil] whileFalse: [

			cntxt := cntxt sender.

			(cntxt selector = condition) ifTrue: [Halt signal].

			].

		^self.

	].

	(condition isBlock

			ifTrue: [condition cull: self]

			ifFalse: [condition]

	) ifTrue: [

		Halt signal

	].

O comentário do método #haltIf: é bem esclarecedor:

“This is the typical message to use for inserting breakpoints during
debugging. Param can be a block or expression, halt if true.
If the Block has one arg, the receiver is bound to that.
If the condition is a selector, we look up in the callchain. Halt if
any method’s selector equals selector.”

que em português ficaria:

“Esta é a típica mensagem para inserir breakpoints (ponto de interrupção) durante o
debugging (depuração). O parâmetro pode ser um bloco ou expressão, parando a execução do programa se retornar true.
Se o bloco tem um argumento, o receptor (self) é passado para mesmo.
Se a condição é um selector (seletor de mensagem ou método), é verificado se está no callchain (sequência de invocações na pilha de chamadas). Para a execução se o seletor de qualquer método coincide com o seletor passado como argumento.”

Veja abaixo como usar #haltIf: com uma expressão:

Para ilustrar o uso de #halIf: com um bloco veja os screenshots abaixo:

Para demonstrar a detecção de um seletor no callchain é preciso um pouco mais de elaboração: