Application create: #ZwkExtensions with: (#( AbtCLDTAdditions) collect: [:each | Smalltalk at: each ifAbsent: [ Application errorPrerequisite: #ZwkExtensions missing: each]])! ZwkExtensions becomeDefault! AdditiveSequenceableCollection subclass: #Graph instanceVariableNames: 'nodes nodeByData data ' classVariableNames: '' poolDictionaries: ''! ZwkExtensions becomeDefault! Set subclass: #SetWithEquality instanceVariableNames: 'indexMap list ' classVariableNames: '' poolDictionaries: ''! ZwkExtensions becomeDefault! Object subclass: #GraphElement instanceVariableNames: 'graph data ' classVariableNames: '' poolDictionaries: ''! ZwkExtensions becomeDefault! GraphElement subclass: #GraphArc instanceVariableNames: 'from to ' classVariableNames: '' poolDictionaries: ''! ZwkExtensions becomeDefault! GraphElement subclass: #GraphNode instanceVariableNames: 'pre post ' classVariableNames: '' poolDictionaries: ''! ZwkExtensions becomeDefault! Object subclass: #GraphSearch instanceVariableNames: 'foundBlock reference ' classVariableNames: '' poolDictionaries: ''! ZwkExtensions becomeDefault! GraphSearch subclass: #GraphSearchVia instanceVariableNames: 'next worker ' classVariableNames: '' poolDictionaries: ''! ZwkExtensions becomeDefault! GraphSearchVia subclass: #GraphSearchMap instanceVariableNames: 'toArray toFirstIndex ' classVariableNames: '' poolDictionaries: ''! ZwkExtensions becomeDefault! Object subclass: #IndexMap instanceVariableNames: 'indexByElement elementByIndex ' classVariableNames: 'ObjectMap ' poolDictionaries: ''! ZwkExtensions becomeDefault! WriteStream subclass: #WriteStreamPlus instanceVariableNames: 'intendation printIdBlock isStoppedBlock ' classVariableNames: '' poolDictionaries: ''! ZwkExtensions becomeDefault! Application subclass: #ZwkExtensions instanceVariableNames: '' classVariableNames: '' poolDictionaries: ''! ZwkExtensions becomeDefault! !ArrayedCollection class publicMethods ! withAll: aCollection ^(self new: aCollection size) replaceFrom: 1 with: aCollection; yourself! ! !Bag publicMethods ! doWithOccurrences: aBlock self occurrenceDictionary keysAndValuesDo: aBlock ! isSameMS: other self supportSize == other supportSize ifFalse: [^false]. other doWithOccurrences: [:ele :occ | occ == (self occurrencesOf: ele) ifFalse: [^false]]. ^true! removeAllOccurences: anObject "Answer anObject after removing all its occurences equivalent from the receiver." occurrenceDictionary removeKey: anObject ifAbsent: []. ^anObject! supportSize ^ self occurrenceDictionary size ! ! !Character publicMethods ! lssOP: aCharacter self = aCharacter ifTrue: [^nil]. self assert: [aCharacter isCharacter]. ^self value < aCharacter value! ! !Collection class publicMethods ! withAll: aCollection ^(self new: aCollection size) addAll: aCollection; yourself! ! !Collection publicMethods ! addIfUnique: newElement ^ (self includes: newElement) not and: [self add: newElement. true]! any "answer an arbitrary object the receiver" self do: [:ele | ^ele]. self error: 'empty'! any: anyBlock do: restBlock "first evaluate the anyblock for an arbitrary element of the receiver, afterwards evaluate the restBlock for all remaining elements" | first | first := true. self do: [:ele | first ifTrue: [first := false. anyBlock value: ele] ifFalse: [restBlock value: ele]]! asAssociations | arr index | arr := Array new: self size. index := 0. self associationsDo: [:ass | arr at: (index :=index + 1) put: ass]. ^ arr! asDictionaryBy: aBlock "Answer aDictionary containing each element of the receiver at (aBlock value: element) fail if the keys are not unique" | dict | dict := Dictionary new: self size. self do: [:ele | dict atAbsent: (aBlock value: ele) put: ele]. ^dict! asDictionaryOCBy: aBlock "Answer aDictionary containing each element of the receiver in an OrderedCollection at (aBlock value: element)" | dict | dict := Dictionary new: self size. self do: [:ele | (dict at: (aBlock value: ele) ifAbsentPut: [OrderedCollection new]) add: ele]. ^dict! copyCollection "copy the receiver as anIndependent collection, with identic elements" ^ self copy! counts | counts | counts := Dictionary new. self do: [:ele | counts at: ele put: 1 + (counts at: ele ifAbsent: [0])]. ^ counts! difference: aCollection "answer the difference of the receiver and aCollection as a new collection using MultiSet semantics" ^ self copy removeAllPresent: aCollection; yourself! doWithAny: aBlock "answer the union of the receiver and aCollection as a new collection" | any first | first := true. self do: [:ele | first ifTrue: [first := false. any := ele]. aBlock value: ele value: any]! doWithNext: aBlock "answer the union of the receiver and aCollection as a new collection" | previous first | first := true. self do: [:ele | first ifTrue: [first := false] ifFalse: [aBlock value: previous value: ele]. previous := ele]! filter: filterBlock add: newObject "Answer the filtered of newObject after adding it to the receiver, answer nil and do not change the receiver if does not pass the filter" filterBlock value: newObject value: [:filtered | ^ self add: filtered]. ^ nil ! filter: filterBlock addAll: aCollection "Answer aCollection, having added all elements of aCollection filtered by filterBlock to the receiver." aCollection do: [:ele | self filter: filterBlock add: ele]. ^ aCollection ! graphNeighbours "answer the neighbours nodes of the receiver" | nei | nei := self species new. self do: [:nd | nei addAll: nd prePostNodes]. ^ nei removeAllPresent: self; yourself ! includesAll: aCollection "Answer a Boolean which is true if the receiver includes all elements of aCollection" ^ aCollection conform: [:ele | self includes: ele]! includesAny: aCollection "Answer a Boolean which is true if the receiver includes all elements of aCollection" aCollection detect: [:ele | self includes: ele] ifNone: [^ false]. ^true! injectFirst: firstBlock into: aBlock "Answer an Object which is the final result of iteratively evaluating the two argument block, aBlock using the previous result of evaluating aBlock and each element of receiver as arguments. The first argument of aBlock represents the result of the previous iteration and the second represents an element in the receiver. The initial value for the first block argument is the value of firstBlock with the first element" | first injectValue | first := true. self do: [:element | injectValue := first ifTrue: [first := false. firstBlock value: element] ifFalse: [aBlock value: injectValue value: element]]. ^injectValue! injectFirstInto: aBlock "Answer an Object which is the final result of iteratively evaluating the two argument block, aBlock using the previous result of evaluating aBlock and each element of receiver as arguments. The first argument of aBlock represents the result of the previous iteration and the second represents an element in the receiver. The initial value for the first block argument is the value of firstBlock with the first element" | first injectValue | first := true. self do: [:element | injectValue := first ifTrue: [first := false. element] ifFalse: [aBlock value: injectValue value: element]]. ^injectValue! intersection: aCollection "answer the intersection of the receiver and aCollection in a new collection" | inter | ^ self copy removeAllNotIn: aCollection; yourself! isCollection "Answer whether the receiver is a collection" ^true! isSameBag: aCollection "Answer whether the receiver and aCollection have the same elements with the same occurrences" | bag | self size == aCollection size ifFalse: [^false]. (bag := Bag new) addAll: self. aCollection do: [:ele | bag remove: ele ifAbsent: [^ false]]. ^ bag isEmpty! isSameSet: aCollection "Answer whether the receiver and aCollection have the same elements ignoring occurrences" ^self asSet isSameSet: aCollection! isSingleWith: anObject ^ (self singleIfNot: [^ false]) = anObject! maximasPO: lssBlock "answer the maximal elements of the receiver, as determinied by the two argument block aBlock. aBlock must answer true if first argument < second false if first argument > second nil if non comparable (or equal)" | res | res := OrderedCollection new. self do: [:ele | res maximasPO: lssBlock add: ele]. ^ res! pattern "answer a common pattern for the Receiver" | interval any prf sff | interval := self sizeInterval. any := self any. prf := self prefixSize. prf = interval to ifTrue: [^ any copy]. sff := self suffixSizeMin: interval from - prf. ^ interval from = interval to ifTrue: [any copyReplaceFrom: prf+1 to: (interval from - sff) withObject: $#] ifFalse: [(any copyFrom: 1 to: prf), '*', (any copyFrom: any size - sff + 1 to: any size)]! prefixSize "answer the maximal number of elements that is common for all elements, from index 1 assume elements are Sequenceable collections" | prf first index| self isEmpty ifTrue: [^ 0]. self do: [:ele | prf isNil ifTrue: [(prf := (first := ele) size) < 1 ifTrue: [^ 0]] ifFalse: [ prf > ele size ifTrue: [(prf := ele size) < 1 ifTrue: [^ 0]]. index := 0. [(index := index + 1) <= prf] whileTrue: [ (first at: index) = (ele at: index) ifFalse: [(prf := index - 1) < 1 ifTrue: [^ 0]]]]]. ^ prf! removeAll "remove all elementss from the receiver" self removeAll: self! removeAllNotIn: aCollection "remove from the receiver each element that is not in aCollection use MultiSet semantics >>>> use mulitSet identity A intersection: B = A \ (A \ B) " self removeAllPresent: (self copy removeAllPresent: aCollection)! removeAllPresent: aCollection "remove from the receiver each element in Collection (if it is present) using MultiSet semantics" aCollection do: [:ele | self remove: ele ifAbsent: []]! removeAny "answer an arbitrary object after removing it from the receiver" self do: [:ele | self remove: ele. ^ele]. self first. "trigger error"! removeDo: aBlock "evaluate aBlock for an arbitrary element removed from the receiver, until the receiver is empty answer self" [self isEmpty] whileFalse: [aBlock value: self removeAny]. ! removeLast: anObject ifAbsent: aBlock "remove the last element of the receiver equivalent to anObject." ^ self remove: anObject ifAbsent: aBlock value! single self assert: [self size = 1]. ^ self any! singleIfEmpty: aBlock ^ self size = 1 ifTrue: [self any] ifFalse: [self isEmpty ifTrue: [aBlock value] ifFalse: [self fail: 'not single']]! singleIfNot: aBlock ^ self size = 1 ifTrue: [self any] ifFalse: [aBlock value] ! sizeInterval "answer interval of the sizes of the elements of the receiver" | min max sz | self isEmpty ifTrue: [^ 0 to: -1]. self do: [:ele | max isNil ifTrue: [min := max := ele size] ifFalse: [(sz := ele size) < min ifTrue: [min := sz] ifFalse: [sz > max ifTrue: [max := sz]]]]. ^min to: max! subsetPO: aCollection "answer true if receiver is a subset or equal aCollection false if aCollection is a subset of receiver nil if not comparable" ^ (aCollection includesAll: self) or: [(self includesAll: aCollection) ifTrue: [false] ifFalse: [nil]]! suffixSize "answer the maximal number of elements that is common for all elements, from the last index downwards assume elements are Sequenceable collections" | sff first index| self isEmpty ifTrue: [^ 0]. self do: [:ele | sff isNil ifTrue: [(sff := (first := ele) size) < 1 ifTrue: [^ 0]] ifFalse: [ sff > ele size ifTrue: [(sff := ele size) < 1 ifTrue: [^ 0]]. index := -1. [(index := index + 1) < sff] whileTrue: [ (first at: first size - index) = (ele at: ele size - index) ifFalse: [(sff := index) < 1 ifTrue: [^ 0]]]]]. ^ sff! suffixSizeMin: minima "answer the maximal number of elements that is common for all elements, from the last index downwards assume elements are Sequenceable collections" | sff first index| self isEmpty ifTrue: [^ 0]. self do: [:ele | sff isNil ifTrue: [(sff := (first := ele) size min: minima) < 1 ifTrue: [^ 0]] ifFalse: [ sff > ele size ifTrue: [(sff := ele size) < 1 ifTrue: [^ 0]]. index := -1. [(index := index + 1) < sff] whileTrue: [ (first at: first size - index) = (ele at: ele size - index) ifFalse: [(sff := index) < 1 ifTrue: [^ 0]]]]]. ^ sff! union: aCollection "answer the union of the receiver and aCollection as a new collection" ^ self copy addAll: aCollection; yourself! with: aCollection conform: aBlock "answer aBoolean whether aBlock answers true for every corresponding element of the receiver and aCollection answer false if there is no 1-to-1 correspondence" self size = aCollection size ifFalse: [^ false]. aCollection doWithIndex: [:element :index | (aBlock value: (self at: index) value: element) ifFalse: [^ false]]. ^ true! with: aCollection do: aBlock "Iteratively evaluate the two argument block, aBlock using each element of the receiver and the corresponding element of aSequenceableCollection. fail if the two collections are not corresponding" (self with: aCollection conform: [:left :right | aBlock value: left value: right. true]) ifFalse: [self fail: 'not conform']! with: aCollection is1to1: aBlock "answer aBoolean whether there is a 1to1 relation between the receiver and aCollection such that aBlock answers true for corresponding elements assume aBlock determines an equivalence relation" | rest index | self size = aCollection size ifFalse: [^false]. (rest := OrderedCollection new) addAll: aCollection. self do: [:ele | (index := rest findFirst: [:restEle | (aBlock value: ele value: restEle)]) = 0 ifTrue: [^false]. rest removeFastAtIndex: index]. ^ true ! ! !EsRandom class publicMethods ! newReproducible: seed "Use linear congruential generator, with a shuffling array. Reference: Numerical Recipes in C, The Art of Scientific Computing Press et al., Cambridge University Press 1990, pp. 211, 212" | randomStream | randomStream := super new. randomStream seed2: seed asFloat; basicNext; shuffleArray: (Array new: randomStream shuffleSize). 1 to: randomStream shuffleSize do: [ :index | randomStream shuffleArray at: index put: randomStream basicNext]. randomStream seed1: randomStream seed2. ^randomStream! ! !EsRandom publicMethods ! nextDecreasingTo: to "Answer an Integer which is the next pseudo-random number in the interval [1 to] with the answers 1 2 ... to having a (relative) probability distribution to (to-1) ... 1" | val | ^self scale: ((2 * to + 1) - ((2 * to + 1) squared - (4 * to * (to+1) * self next)) sqrt) / (2 * to) from: 1 to: to ! nextFrom: from to: to "Answer an Integer which is the next pseudo-random number in the interval [1 to] with equal distribution" ^self scale: self next from: from to: to ! nextTo: to "Answer an Integer which is the next pseudo-random number in the interval [1 to] with equal distribution" ^self scale: self next from: 1 to: to ! permutationOf: aColl "Answer an Array with a random permutation of [1 to]" | res free freeIx to | res := aColl copy. free := (1 to: (to := aColl size)) asArray. 1 to: aColl size do: [:from | res at: (free at: (freeIx := self nextTo: to)) put: (aColl at: from). free at: freeIx put: (free at: to). to := to - 1]. ^res ! scale: float from: from to: to | scaled | "scale the float linearily from [0 1) to [from, from+1, from+2, ... to]" scaled := from + (float * (to - from - 0.5)) rounded. self assert: [scaled between: from and: to]. ^ scaled ! ! !EsString publicMethods ! asLc1 "Answer a String whose first character is translated to lowercase" ^ self first asLowercase asString, (self copyFrom: 2 to: self size)! showString ^ self! ! !Graph class publicMethods ! new ^ self new: 10! new: size ^ self basicNew initialize: size! test1 "Graph test1" | inst | (inst := self new) addAll: #('a' 'a1' 'a2' 'b' 'b3' 'b4'). inst do: [:from | inst do: [:to | (to isSubCollection: from startingAt: 1) ifTrue: [inst connect: from to: to]]]. ^ inst! ! !Graph publicMethods ! add: newObject self newNode data: newObject. ^newObject! addGraph: aGraph "add copies of the nodes and arcs of aGraph" self addNodesAndArcsLike: aGraph nodes! addNode: aNode "answer aNode after having added it to the receiver" self assert: [aNode graph isNil and: [aNode pre isEmpty and: [aNode post isEmpty]]]. aNode graph: self. self nodes add: aNode. self node: aNode changes: nil data: aNode data. ^ aNode! addNodes: newNodeBlock andArcsLike: aCollection "add a copies of the elements of aCollection of nodes, their neighbours and connecting arcs to the receiver. answer aDictionary mapping aCollection to the added nodes of the receiver" | dict newNd arcs addNode | addNode := [:old | (self addNode: (newNodeBlock value: old)) copyDataFrom: old; yourself]. dict := Dictionary new. arcs := Set new. aCollection do: [:nd | newNd := dict at: nd ifAbsentPut: [addNode value: nd]. nd pre do: [:arc | (arcs addIfUnique: arc) ifTrue: [ (dict at: arc from ifAbsentPut: [addNode value: arc from]) connectTo: newNd like: arc]]. nd post do: [:arc | (arcs addIfUnique: arc) ifTrue: [ newNd connectTo: (dict at: arc to ifAbsentPut: [addNode value: arc to]) like: arc]]]. ^ dict! addNodesAndArcsLike: aCollection "add a copies of the elements of aCollection of nodes, their neighbours and connecting arcs to the receiver. answer aDictionary mapping aCollection to the added nodes of the receiver" ^self addNodes: [:old | old class new] andArcsLike: aCollection! arc: newArc from: from to: to self assert: [newArc graph isNil and: [from graph == self and: [to graph == self]]]. newArc graph: self; from: from; to: to. from post add: newArc. to pre add: newArc. ^ newArc ! arcs | res | res := OrderedCollection new. self arcsDo: [:arc | res add: arc]. ^ res! arcsDo: aBlock self nodes do: [:nd | nd post do: [:arc | aBlock value: arc]]. ! at: anIndex ^ self nodes at: anIndex! connect: from to: to ^ self arc: self newArc from: (self nodeAt: from) to: (self nodeAt: to) ! connectDataFrom: from to: to arc: arc ^ ((self nodeAt: from ifAbsent: [self newNode data: from]) connectTo: (self nodeAt: to ifAbsent: [self newNode data: to])) data: arc; yourself! copyCollection ^ self class new copyDataFrom: self; addGraph: self; yourself! copyDataFrom: aGraph "copy the data from aGraph"! data ^ data! data: anObject data := anObject.! depthFirstDo: aBlock " evaluate aBlock for all nodes of the graph in depth first order" | stopper | stopper := self newSet. self nodesDo: [:nd | nd depthFirstStopper: stopper do: aBlock] ! depthFirstStopper: stopper do: aBlock self nodes do: [:nd | nd pre isEmpty ifTrue: [nd depthFirstStopper: stopper do: aBlock]]. self nodes do: [:nd | nd depthFirstStopper: stopper do: aBlock]. ! do: aBlock " evaluate aBlock for all nodes of the graph" self nodesDo: [:nd | aBlock value: nd data] ! equivalenceMap: search fromNode: aNode | doit | doit := [:coNo | search map at: aNode put: coNo. aNode equivalenceMap: search to: coNo]. aNode data isNil ifFalse: [doit value: (self nodeAt: aNode data)] ifTrue: [ self nodes do: [:coNo | aNode data = coNo data ifTrue: [doit value: coNo]]]. search map removeKey: aNode ifAbsent: []. ! initialize: size self nodes: (OrderedCollection new: size); nodeByData: Dictionary new! initialNodes ^ self nodes select: [:nd | nd pre isEmpty]! isTree ^ false! leaves ^ self nodes select: [:nd | nd isLeaf]! map: aMap nodesLeaf: leafBlock map: mapDict "map the nodes, but not the exports from aMap source to the receiver, assuming they are in parallel order answer aBoolean whether succesful or not" ^ (aMap source nodes reject: [:src | src isExport]) with: (self nodes reject: [:dst | dst isExport]) conform: [:src :dst | aMap origin: src image: dst. src is: dst equivalentMap: mapDict leaf: leafBlock] ! newArc ^ GraphArc new ! newArcFrom: from to: to ^ self arc: self newArc from: from to: to ! newMS ^Bag new! newNode ^ self addNode: self nodeClass new! newNodeLike: aNode "answer a new Node of the receiver with class and data from aNode" ^ (self addNode: aNode class new) copyDataFrom: aNode! node: aNode changes: oldData data: newData "register the change of data of one of the receivers node" self assert: [aNode graph == self]. self nodeByData isNil ifTrue: [^self]. oldData isNil ifFalse: [(self nodeByData removeKey: oldData) == aNode ifFalse: [self error: 'data-node mismatch']]. newData isNil ifFalse: [self nodeByData atAbsent: newData put: aNode]! nodeAt: aData ^ self nodeByData isNil ifTrue: [self nodes detect: [:nd | nd data = aData]] ifFalse: [self nodeByData at: aData]! nodeAt: aData ifAbsent: aBlock ^ self nodeByData isNil ifTrue: [self nodes detect: [:nd | nd data = aData] ifAbsent: aBlock] ifFalse: [self nodeByData at: aData ifAbsent: aBlock]! nodeByData ^ nodeByData! nodeByData: anObject nodeByData := anObject.! nodeClass ^ GraphNode! nodes ^ nodes! nodes: anObject nodes := anObject.! nodesDo: aBlock " evaluate aBlock for all nodes of the graph" self nodes do: aBlock ! pathsFrom: start to: stop do: aBlock self nodes do: [:nd | nd pathsFrom: start to: stop do: aBlock]! pathsNavigate: aBlock | res | self nodes conform: [:nd | (res := nd pathsNavigate: aBlock) >= 0]. ^ res! printDetailsOn: aStream self depthFirstStopper: [:sub | aStream isStopped: sub] do: [:sub | aStream printDetailsAlways: sub]! printStatsOn: aStream | dict first | first := true. dict := self stats keysAndValuesDo: [:cla :bag | first ifTrue: [first := false] ifFalse: [aStream nextPutAll: ', ']. bag size printOn: aStream. cla printOn: aStream space. (bag removeAllOccurences: UndefinedObject; isEmpty) ifFalse: [ first := true. aStream nextPut: $(. bag doWithOccurrences: [:dat :cnt | first ifTrue: [first := false] ifFalse: [aStream space]. cnt printOn: aStream. dat printOn: aStream space]. aStream nextPut: $)]]. ! root self fail: 'not tree'! roots ^ self nodes select: [:nd | nd isRoot]! size ^ self nodes size! stats " answer a Dictionary with key the class of the nodes of the receiver and the values Bag of the class of data of the node" | dict | dict := Dictionary new. self nodes do: [:nd | nd addToStats: dict. nd post do: [:arc | arc addToStats: dict]]. ^ dict! ! !GraphArc publicMethods ! from ^ from! from: anObject from := anObject.! isArc ^ true! printOn: aStream aStream printId: self from; nextPutAll: '>-'; printId: self data; nextPutAll: '->'; printId: self to! to ^ to! to: anObject to := anObject.! ! !GraphElement class publicMethods ! new ^ super new initialize! ! !GraphElement publicMethods ! addToStats: aDictionary | ass | (aDictionary at: self class ifAbsentPut: [Bag new]) add: self data class! copyDataFrom: anElement self data: anElement data! data ^ data! data: anObject data := anObject.! graph ^ graph! graph: anObject graph := anObject.! initialize! isArc ^ false! isNode ^ false! isTree ^ self graph isTree! newMS ^ self graph newMS! newSet ^ self graph newSet! printConcatChar ^ $@! printOn: aStream | word | self class name asLc1! root ^ self graph root! ! !GraphNode publicMethods ! arcTo: aNode ^ (self post select: [:arc | arc to == aNode]) single! arcTo: aNode ifAbsent: aBlock ^ (self post select: [:arc | arc to == aNode]) singleIfEmpty: aBlock! areaByDataPair "answer a Dictionary with the nodes of the area as key and data pairs as values" ^ Dictionary fromInverse: self areaDataByNode! areaDataByNode "answer a Dictionary with the nodes of the area as key and data pairs as values" | dict val | dict := IdentityDictionary new. self pre do: [:arc | val := dict at: arc from ifAbsentPut: [Array with: 0 with: 0]. self assert: [(val at: 1) = 0]. val at: 1 put: arc data]. self post do: [:arc | val := dict at: arc to ifAbsentPut: [Array with: 0 with: 0]. self assert: [(val at: 2) = 0]. val at: 2 put: arc data]. ^ dict! child ^ self post single to ! childNamed: aName ^ (self post detect: [:arc | arc to name = aName]) to! childNamed: aName ifNone: aBlock ^ (self post detect: [:arc | arc to name = aName] ifNone: [^ aBlock value]) to! children ^ self post collect: [:arc | arc to]! childrenFirstDo: aBlock " evaluate aBlock for the receiver and its siblings, stack overflow if cyclic" self post do: [:arc | arc to childrenFirstDo: aBlock]. aBlock value: self. ! connectTo: to ^ self graph newArcFrom: self to: to ! connectTo: to like: model ^ (self graph newArcFrom: self to: to) copyDataFrom: model; yourself ! data: anObject self graph node: self changes: self data data: anObject. data := anObject.! depthFirstDo: aBlock " evaluate aBlock for the receiver and its siblings, stack overflow if cyclic" aBlock value: self. self post do: [:arc | arc to depthFirstDo: aBlock]! depthFirstStopper: stopper do: aBlock " evaluate aBlock for all receiver and all siblings, if not in stopper" (stopper value: self) ifFalse: [ aBlock value: self. self post do: [:arc | arc to depthFirstStopper: stopper do: aBlock]]! disconnectArcs "disconnect the receiver from it's arc, by making them dangling" self pre do: [:arc | arc to: nil]. self post do: [:arc | arc from: nil]. ! equivalenceMap: search to: aNode | node des | ((search node value: self value: aNode) and: [self pre size = aNode pre size and: [self post size = aNode post size]]) ifFalse: [^false]. self pre do: [:arc | search map at: arc from ifPresent: [:from | (search arc value: arc value: (from arcTo: aNode ifAbsent: [^false])) ifFalse: [ ^false]]]. self post do: [:arc | search map at: arc to ifPresent: [:to | (search arc value: arc value: (aNode arcTo: to ifAbsent: [^false])) ifFalse: [ ^false]]]. search found! finalInterfaceFrom | node | node := self isExport ifTrue: [self pre single from] ifFalse: [self]. [node isInterface] whileTrue: [ self assert: [node isImport and: [node preInterfaces single isExport]]. node := node preInterfaces single pre single from]. ^ node! finalInterfaceTo | node | node := self. [node isInterface] whileTrue: [ node := node isFromDeclarer ifTrue: [node postInterfaces single] ifFalse: [node post single to]]. ^ node! importDataPath | pa nd | pa := OrderedCollection new. nd := self. [nd isImport] whileTrue: [ pa add: nd interfaceArc data. nd := nd interfaceExport exportOf]. self assert: [nd isExport not]. pa add: nd data. ^pa asArray! initialAncestor ^ (self parentIfNone: [^ self]) initialAncestor! initialize self pre: OrderedCollection new; post: OrderedCollection new! interfaceFinal ^self! isEquivalent: other type: aType leaf: leafBlock "answer aBoolean whether the receiver and the node dst are equivalent by virtue of leafBlock: to compare to leaf nodes and aType for subComponents" ^ self isInterface = other isInterface and: [leafBlock value: self value: other] ! isExport ^false! isImport ^false! isInterface ^false! isLeaf ^ self post isEmpty! isNameEquivalent: other type: aType leaf: leafBlock "answer aBoolean whether the receiver and the node dst are equivalent by virtue of leafBlock: to compare to leaf nodes and aType for subComponents" ^ self nameTrunc = other nameTrunc and: [self isEquivalent: other type: aType leaf: leafBlock]! isNode ^ true! isRoot ^ self pre isEmpty! leaves | leaves | leaves := OrderedCollection new. self depthFirstDo: [:nd | nd isLeaf ifTrue: [leaves add: nd]]. ^ leaves! newChild | child | self connectTo: (child := self graph newNode). ^ child! newChildNamed: aName ^ self newChild name: aName; yourself! newChildNamed: aName data: newData ^ self newChild name: aName; data: newData; yourself! parent ^ self pre single from ! parentArcsPath | path node | path := OrderedCollection new. node := self. [path size > 200 ifTrue: [self halt]. true] whileTrue: [ node := (path addFirst: (node pre singleIfEmpty: [^path])) from].! parentIfNone: aBlock "answert the receivers parent evaluate aBlock if none fail if more the one pre" ^ (self pre singleIfEmpty: [^ aBlock value]) from! parentPath | path node | path := OrderedCollection with: (node := self). [path size > 200 ifTrue: [self halt]. true] whileTrue: [path addFirst: (node := node parentIfNone: [^path])].! path: path at: index navigate: aBlock | res | path from: 2 to: index - 1 do: [:nd | nd = self ifTrue: [^ index]]. path at: index put: self. (res := aBlock value: path value: index) < index ifTrue: [^ res]. (index > 1 and: [path first = self]) ifTrue: [^ index]. self prePostNodes do: [:nd | (res := nd path: path at: index + 1 navigate: aBlock) < index ifTrue: [ ^ res]]. ^ index! pathsFrom: start to: stop do: aBlock self path: (Array new: stop + 1) at: 1 navigate: [:pa :index | (index - 1 between: start and: stop) ifTrue: [aBlock value: (pa copyFrom: 1 to: index)]. stop] ! pathsNavigate: aBlock | path | path := Array new: self graph nodes size + 1. ^ self path: path at: 1 navigate: aBlock! post ^ post! post: anObject post := anObject.! postByTo ^ self post asDictionaryOCBy: [:arc | arc to]! postMS | ms | ms := self newMS. self post do: [:arc | ms add: arc from withOccurrences: arc data]. ^ms! postNodes ^ self post collect: [:arc | arc to]! pre ^ pre! pre: anObject pre := anObject.! preMS | ms | ms := self newMS. self pre do: [:arc | ms add: arc from withOccurrences: arc data]. ^ms! preNodes ^ self pre collect: [:arc | arc from]! prePost ^ self pre, self post! prePostNodes | pp | pp := self newSet. self pre do: [:arc | pp add: arc from]. self post do: [:arc | pp add: arc to]. ^ pp! printOn: aStream aStream nextPutAll: self data showString! printPathOn: aStream self rootPathNodes printOn: aStream do: [:nd | aStream nextPutAll: nd name]! printStatsOn: aStream aStream nextPutAll: self pre size printString; nextPutAll: '<>'; nextPutAll: post size printString; nextPut: $:. self post do: [:arc | aStream space; printId: arc]! removeWithArcs "remove the receiver with it's arcs from the receiver's graph" self pre do: [:arc | arc from == self ifFalse: [arc from post remove: arc]]. self post do: [:arc | arc to == self ifFalse: [arc to pre remove: arc]]. self graph nodes remove: self ! stealArcFrom: anArc "answer anArc after connecting with it to the receiver" self assert: [self graph == anArc graph and: [anArc from graph == self graph]]. self pre add: anArc. anArc to: self. ^ anArc ! stealArcsOf: aNode "steal all arcs of a node" self assert: [self graph == aNode graph]. aNode pre do: [:arc | self stealArcFrom: arc]. aNode pre removeAll. aNode post do: [:arc | self stealArcTo: arc]. aNode post removeAll. ! stealArcTo: anArc "answer anArc after connecting with it to the receiver" self assert: [self graph == anArc graph and: [anArc to graph == self graph]]. self post add: anArc. anArc from: self. ^ anArc ! ! !GraphSearch class publicMethods ! found: foundBlock "create an instance of the receiver with unitialized reference" ^ self new foundBlock: foundBlock; yourself ! found: foundBlock reference: aReference "create an instance of the receiver with the indicated reference" ^ self new foundBlock: foundBlock; reference: aReference; yourself ! next: target reference: reference collection: aCollection andSearch: aBlock ^(GraphSearchVia found: aBlock reference: reference) next: target viaCollection: aCollection ! next: target reference: reference permutations: aCollection andSearch: aBlock ^(GraphSearchMap found: aBlock reference: reference) next: target viaCollection: aCollection mapTo: aCollection ! next: target reference: reference worker: aWorker search: aBlock ^(GraphSearchVia found: aBlock reference: reference) next: target; worker: aWorker; yourself ! testPermutations "GraphSearch testPermutations" | srch | srch := (self found: [:ref | Transcript cr; show: ref map printString; show: ' toArray '; show: srch toArray printString]) map: OrderedCollection new node: nil arc: nil; viaPermutations: #(1 2 3) andSearch: [:f :t :s | s map add: t. s found. s map removeLast]. srch found. Transcript cr; show: 'after search toArray '; show: srch toArray printString.! ! !GraphSearch publicMethods ! arc self assert: [(self reference first at: 4) == #arc]. ^self reference at: 4! back self assert: [(self reference first at: 3) == #back]. ^ self reference at: 3! back: anObject self assert: [(self reference first at: 3) == #back]. self reference at: 3 put: anObject! found ^ self foundBlock value: self! foundBlock ^ foundBlock! foundBlock: anObject self assert: [anObject argumentCount = 1]. foundBlock := anObject.! image self assert: [(self reference first at: 2) == #image]. ^self reference at: 2! image: anImage self assert: [(self reference first at: 2) == #image]. ^self reference at: 2 put: anImage! lock self assert: [(self reference first at: 8) == #lock]. ^self reference at: 8! lock: anObject self assert: [(self reference first at: 8) == #lock]. self reference at: 8 put: anObject! map self assert: [(self reference first at: 2) == #map]. ^self reference at: 2! map: aMap node: node arc: arc "create the reference of the receiver with the indicated fields" self reference: (Array with: (Array with: nil with: #map with: #node with: #arc) with: aMap with: node with: arc) ! mapOne self assert: [(self reference first at: 3) == #mapOne]. ^self reference at: 3! mapOne: one self assert: [(self reference first at: 3) == #mapOne]. ^self reference at: 3 put: one! mapsFilter self assert: [(self reference first at: 10) == #mapsFilter]. ^self reference at: 10! mapsFilter: anObject self assert: [(self reference first at: 10) == #mapsFilter]. self reference at: 10 put: anObject! mapTwo self assert: [(self reference first at: 4) == #mapTwo]. ^self reference at: 4! mapTwo: two self assert: [(self reference first at: 4) == #mapTwo]. ^self reference at: 4 put: two! node self assert: [(self reference first at: 3) == #node]. ^self reference at: 3! reduce self assert: [(self reference first at: 2) == #reduce]. ^self reference at: 2! reduce: anObject self assert: [(self reference first at: 2) == #reduce]. self reference at: 2 put: anObject! reference ^ reference! reference: anObject reference := anObject.! referenceDictionary | dict | dict := Dictionary new. 2 to: self reference size do: [:ix | dict at: (self reference first at: ix) put: (self reference at: ix)]. ^dict! referenceMapOneTwo "create the reference of the receiver with the indicated fields" self reference: (Array new: 6). self reference at: 1 put: #(nil #image #mapOne #mapTwo #stopper #forbidden).! referenceReduce "create the reference of the receiver with the indicated fields" self reference: (Array new: 10). self reference at: 1 put: #(nil #reduce #back #toDo #stopper #forbidden #relation #lock #structure #mapsFilter).! relation self assert: [(self reference first at: 7) == #relation]. ^self reference at: 7! relation: anObject self assert: [(self reference first at: 7) == #relation]. self reference at: 7 put: anObject! stopper self assert: [(self reference first at: 5) == #stopper]. ^self reference at: 5! stopper: anObject self assert: [(self reference first at: 5) == #stopper]. self reference at: 5 put: anObject! structure self assert: [(self reference first at: 9) == #structure]. ^self reference at: 9! structure: anObject self assert: [(self reference first at: 9) == #structure]. self reference at: 9 put: anObject! toDo self assert: [(self reference first at: 4) == #toDo]. ^ self reference at: 4! toDo: anObject self assert: [(self reference first at: 4) == #toDo]. self reference at: 4 put: anObject! via: worker search: aBlock ^self class next: self reference: self reference worker: worker search: aBlock! viaCollection: aCollection andSearch: aBlock ^ self class next: self reference: self reference collection: aCollection andSearch: aBlock! viaPermutations: aCollection andSearch: aBlock ^ self class next: self reference: self reference permutations: aCollection andSearch: aBlock ! ! !GraphSearchMap publicMethods ! found "map the worker to all remaining elements of toArray" | last this | self toFirstIndex to: self toArray size do: [:ix | last := self toArray at: self toFirstIndex. self toArray at: self toFirstIndex put: (this := self toArray at: ix); at: ix put: last. self foundBlock value: self worker value: this value: self next. ]. self toFirstIndex to: self toArray size - 1 do: [:ix | self toArray at: ix put: (self toArray at: ix + 1)]. self toArray at: self toArray size put: this.! foundBlock: anObject self assert: [anObject argumentCount = 3]. foundBlock := anObject.! next: target viaCollection: fromCollection mapTo: toCollection | start srch arr | start := srch := self next: target viaCollection: fromCollection. arr := toCollection asArray copy. 1 to: fromCollection size do: [:ix | srch toArray: arr; toFirstIndex: ix. srch := srch next]. ^start! toArray ^ toArray! toArray: anObject toArray := anObject.! toFirstIndex ^ toFirstIndex! toFirstIndex: anObject toFirstIndex := anObject.! ! !GraphSearchVia publicMethods ! found "found: continue search in follower which sits in foundBlock" ^ self foundBlock value: self worker value: self next! foundBlock: anObject self assert: [anObject argumentCount = 2]. foundBlock := anObject.! next ^ next! next: anObject next := anObject.! next: target viaCollection: aCollection | last | aCollection isEmpty ifTrue: [^ target]. aCollection do: [:ele | last isNil ifTrue: [(last :=self) worker: ele] ifFalse: [last next: (last := self copy worker: ele)]]. last next: target. ^self! worker ^ worker! worker: anObject worker := anObject.! ! !IndexMap class publicMethods ! for: anObject ^ self objectMap at: anObject ifAbsentPut: [self new]! for: anObject mapClass: aClass ^ self objectMap at: anObject ifAbsentPut: [self newMapClass: aClass] ifPresent: [:oldMap | oldMap indexByElement class == aClass ifTrue: [oldMap] ifFalse: [self error: 'class ~~']]! for: anObject use: indexMap ^ self objectMap at: anObject ifAbsentPut: [indexMap] ifPresent: [:oldMap | oldMap == indexMap ifTrue: [indexMap] ifFalse: [self error: '~~']]! for: anObject useSameAs: otherObject ^ self objectMap at: anObject ifAbsentPut: [self for: otherObject] ifPresent: [:key :map | self fail]! new ^ self newMapClass: Dictionary! newMapClass: dictionaryClass ^ super new indexByElement:dictionaryClass new; elementByIndex: OrderedCollection new! objectMap ^ ObjectMap! objectMap: anObject ObjectMap := anObject.! reset self objectMap: AbtWeakKeyIdentityDictionary new ! ! !IndexMap publicMethods ! do: aBlock self elementByIndex do: aBlock! doWithIndex: aBlock self elementByIndex doWithIndex: aBlock! elementAt: anIndex ^ self elementByIndex at: anIndex! elementByIndex ^ elementByIndex! elementByIndex: anObject elementByIndex := anObject.! indexAssociationAt: anElement ^ self indexByElement associationAt: anElement ifAbsent: [ self indexAt: anElement. self indexByElement associationAt: anElement] ! indexAt: anElement ^ self indexByElement at: anElement ifAbsentPut: [ self elementByIndex add: anElement; size] ! indexAt: anElement ifAbsent: aBlock ^ self indexByElement at: anElement ifAbsent: aBlock! indexAt: anElement ifPresent: aBlock "Return the result of evaluating aBlock if anElement is the receiver, otherwise return nil." ^ self indexByElement at: anElement ifPresent: aBlock! indexByElement ^ indexByElement! indexByElement: anObject indexByElement := anObject.! ! !KeyedCollection class publicMethods ! from: newBlock inverse: aDictionary ^(self new: aDictionary size) add: newBlock inverse: aDictionary ! fromInverse: aDictionary ^(self new: aDictionary size) addInverse: aDictionary ! ! !KeyedCollection publicMethods ! add: newBlock inverse: aDictionary aDictionary keysAndValuesDo: [:key :value | (self at: value ifAbsentPut: newBlock) add: key]! addDictionary: aDictionary "add the keys and values of a Dictionary, >> is different from addAll: , that reuses the associations and hence is not independent!!!!" aDictionary keysAndValuesDo: [:key :value | self at: key put: value]! addInverse: aDictionary self add: [OrderedCollection new] inverse: aDictionary! anyKey self keysAndValuesDo: [:key :value | ^key ]! copyCollection "copy the receiver as anIndependent collection, with identic elements -> cannot use copy, because copy reuses Associations for Dictionaries!!" ^ (self growEmptyBy: 0) addDictionary: self; yourself! keysAndValuesSelect: aBlock "Answer a Dictionary that is created by iteratively evaluating the two argument block, aBlock using a key and an associated value of receiver and associating the key and the value in the returned Dictionary only if aBlock evaluates to the Boolean true. Fail if aBlock is not a two-argument Block Fail if aBlock does not evaluate to a Boolean." | answer | answer := self growEmptyBy: 0. self keysAndValuesDo: [:key :value | (aBlock value: key value: value) ifTrue: [ answer at: key put: value]]. ^answer! ocAt: aKey ^ self at: aKey ifAbsentPut: [OrderedCollection new]! removeAny self keysAndValuesDo: [:key :value | self removeKey: key. ^ value]! setAt: aKey ^ self at: aKey ifAbsentPut: [Set new]! with: aKeyedCollection conform: aBlock "answer aBoolean whether aBlock answers true for every corresponding element of the receiver and aCollection answer false if there is no 1-to-1 correspondence" self size = aKeyedCollection size ifFalse: [^ false]. aKeyedCollection keysAndValuesDo: [:key :other | (aBlock value: (self at: key ifAbsent: [^false]) value: other) ifFalse: [^false]]. ^ true! ! !Object publicMethods ! assert: aBlock aBlock value ifFalse: [self halt: 'assertion failed']! at: aKey ifAbsent: absentBlock ^ self at: aKey ifAbsentPut: [^ absentBlock value]. ! at: aKey ifAbsent: absentBlock ifPresent: presentBlock ^ presentBlock value: (self at: aKey ifAbsentPut: [^ absentBlock value]). ! at: aKey ifAbsentPut: absentBlock ifPresent: presentBlock | absent value | absent := false. value := self at: aKey ifAbsentPut: [absent := true. absentBlock value]. ^ absent ifTrue: [value] ifFalse: [presentBlock value: value]! at: aKey ifAbsentPut: absentBlock ifPresentPut: presentBlock | absent value | absent := false. value := self at: aKey ifAbsentPut: [absent := true. absentBlock value]. ^ absent ifTrue: [value] ifFalse: [self at: aKey put: (presentBlock value: value)]! at: aKey ifPresent: presentBlock ^ presentBlock value: (self at: aKey ifAbsentPut: [^ nil]). ! atAbsent: aKey put: aValue | absent | self at: aKey ifAbsentPut: [absent := true. aValue]. self assert: [absent = true]. ^ aValue! atAll: aCollection "answer the image of aCollection. fail if the receiver fail in at: ..." ^ aCollection collect: [:or | self at: or] ! fail: aString self halt: 'assertion failed: ', aString asString! inspectorOpen "(OrderedCollection with: 'eins' with: 'zwei') halt; inspectorOpen" | met cla deb | met := (self class whichClassIncludesSelector: #inspect) >> #inspect. (cla := met referencedClasses) size = 1 ifFalse: [self error: 'not unique']. ^ (deb := cla first on: self) owningImage: System image; open; yourself ! isCollection "Answer whether the receiver is a collection" ^false! keysAndValuesConform: aBlock "Iteratively evaluate the two argument block, aBlock using each key and value of the receiver. answer false as soon as aBlock returns false for the first time answer true if it does never" self keysAndValuesDo: [:key :value | (aBlock value: key value: value) ifFalse: [^ false]]. ^ true! lssOP: anObject "Answer true if receiver < anObject false if receiver < anObject nil if = or not comparable" self = anObject ifTrue: [^ nil]. self < anObject ifTrue: [^ true]. self > anObject ifTrue: [^ false]. ^ nil! newSet ^SetWithEquality for: self! newSetWith: anElement ^self newSet add: anElement; yourself! newSetWithAll: aCollection ^self newSet addAll: aCollection; yourself! printDetailsOn: aStream "overwrite this method if there are any details to print, insert a Cr before each line"! printIdOn: aStream "print a unique identification of the receiver" aStream printId: self! printStatsOn: aStream "overwrite this method if there are any statistics (up to a line) to print. no Cr "! sequenceLess: anObject "Answer true if receiver < anObject false if receiver < anObject nil if = or not comparable use sequence comparision for Collections" ^ self lssOP: anObject! showString ^ self printString! useIndexMapOf: anObject IndexMap for: self useSameAs: anObject! ! !OrderedCollection publicMethods ! removeFastAtIndex: anInteger "Answer the receiver after having removing the object at idnex anInteger from it. for efficiency no need to preserve order!!" anInteger = self size ifTrue: [self removeLast] ifFalse: [self at: anInteger put: self removeLast] ! ! !PositionableStream publicMethods ! current "Answer an Object that was the last accessible by the receiver" ^collection at: position! nextWord "Answer a String which is the next word of the receiver or LineDelimiter. NOTE - this method assumes a character stream. Words are separated by space, tab, line feed, form feed, or carriage return." | start stop| start := position. [self size < (start := start + 1) ifTrue: [self setToEnd. ^ '']. (self collection at: start) isSeparator] whileTrue: []. stop := start. [self size < (stop := stop + 1) or: [(self collection at: stop) isSeparator ]] whileFalse: []. self skip: stop - 1 - position. ^ self collection copyFrom: start to: stop - 1. ! nextWordOfLine "Answer a String which is the next word of the receiver an Error if a lineDelimiter is next NOTE - this method assumes a character stream. Words are separated by space, tab, line feed, form feed, or carriage return." | word | ^ (word := self nextWordOrEol) = ##eol ifFalse: [word] ifTrue: [self error: 'no more words in this line']! nextWordOrEol "Answer a String which is the next word of the receiver or ##eol if LineDelimiter or end of stream NOTE - this method assumes a character stream. Words are separated by space, tab, line feed, form feed, or carriage return." | start stop| start := self position. [self size < (start := start + 1) ifTrue: [self setToEnd. ^ ##eol]. (self collection at: start) isSeparator] whileTrue: [ (self collection isSubCollection: self lineDelimiter startingAt: start) ifTrue: [ self skip: start + self lineDelimiter size - self position - 1. ^ ##eol]]. stop := start. [self size < (stop := stop + 1) or: [(self collection at: stop) isSeparator ]] whileFalse: []. self skip: stop - 1 - position. ^ self collection copyFrom: start to: stop - 1. ! peekForAll: target "Answer true if the next obejcts in the receiver are equivalent to the Objects in the receiver" | pos | (pos := position) + target size >= self size ifTrue: [^ false]. target do: [:obj | obj = (self collection at: (pos := pos + 1)) ifFalse: [^ false]]. self skip: target size. ^true ! ! !SequenceableCollection publicMethods ! associationsDo: aBlock "Iteratively evaluate the one argument aBlock using each Association element of the receiver. Fail if aBlock is not a one-argument Block Fail if aBlock's body does not expect an Association as a parameter." self doWithIndex: [:element :index | aBlock value: (Association key: index value: element)]! changingDo: aBlock "do aBlock for every element of the receiver, if aBlock changes the receiver, assume no duplicates under identity " | stopper ix ele found | stopper := EsIdentitySet new. found := true. [found] whileTrue: [ found := false. ix := 0. [(ix := ix + 1) <= self size] whileTrue: [ (stopper addIfUnique: (ele := self at: ix)) ifTrue: [found := true. aBlock value: ele]]]. ! commonStartSize: aCollection aCollection doWithIndex: [:ele :ix | (ix <= self size and: [(self at: ix) = ele]) ifFalse: [^ ix - 1]]. ^ aCollection size! copyFrom: start ^self copyFrom: start to: self size! copyReplace: subCollection with: replacementCollection "Replace the first occurenc of a subCollection of the receiver with the elements of the replacementCollection" | start | start := self indexOfSubCollection: subCollection startingAt: 1 ifAbsent: [self fail]. ^ self copyReplaceFrom: start to: start + subCollection size - 1 with: replacementCollection! doWithComplement: aBlock "Iteratively evaluate the two argument block, aBlock using each element of the receiver, in order, the receiver minus the element on return make sure the receiver is the same again Fail if aBlock is not a two argument block." | index ele temp| self isEmpty ifTrue: [^self]. [ index := 1. aBlock value: (ele := self removeFirst) value: self. [index <= self size] whileTrue: [ temp := ele. ele := self at: index. self at: index put: temp. index := index + 1. aBlock value: ele value: self]] valueOnReturnDo: [self insert: ele atIndex: index]! findFirst: aBlock from: start self from: start to: self size doWithIndex: [ :element :index | (aBlock value: element) ifTrue: [^index]]. ^0! from: start downTo: stop do: aBlock "Iteratively evaluate the one argument block, aBlock using the elements from start to stop in the reciever. Fail if aBlock is not a one argument block." start to: stop by: -1 do: [:index | aBlock value: (self at: index)].! indexOfLast: anElement ifAbsent: exceptionBlock "Answer an Integer which is the last index of within the receiver that is equivalent to the Object anElement. If the receiver does not contain an element that is equivalent to anElement, answer the result of evaluating the zero argument block, exceptionBlock. Fail if the receiver does not contain anElement and exceptionBlock is not a zero-argument Block." self size to: 1 by: -1 do: [:index | (self at: index) = anElement ifTrue: [^ index]]. ^ exceptionBlock value! injectionsTo: aColl node: nodeBlock leaf: leafBlock "search all injections from the receiver into the collection aColl call the three argument block searchBlock for every pair of elements (as second and third parameter) the first parameter is a Block that handles the children of the current node leafBlock is evaluated for every reached leaf" | from | self isEmpty ifTrue: [^ leafBlock value]. [ from := self removeFirst. aColl doWithComplement: [:to :toComp | nodeBlock value: [self injectionsTo: toComp node: nodeBlock leaf: leafBlock] value: from value: to]] valueOnReturnDo: [self addFirst: from] ! isSubCollection: aSubcollection startingAt: anIndex "Answer true if the elements of the receiver starting at anIndex are equivalent to those in the SequenceableCollection aSubcollection. answer false otherwise." | ix | (ix := anIndex - 1) + aSubcollection size > self size ifTrue: [^ false]. aSubcollection do: [:element | element = (self at: (ix := ix + 1)) ifFalse: [^ false]]. ^true ! maximasPO: lssBlock add: newElement "add newElement to the receiver and make it a maximal cut assume the receiver is a cut the answer of the two argument block lssBlock determines maximality: true if first argument < second false if first argument > second nil if non comparable (or equal)" | comp ix | ix := 1. [ix <= self size] whileTrue: [ (comp := lssBlock value: newElement value: (self at: ix)) isNil ifTrue: [ix := ix + 1] ifFalse: [comp ifTrue: [^ self] ifFalse:[ix = self size ifTrue: [self removeLast] ifFalse: [self at: ix put: self removeLast]]]]. self add: newElement.! removeLast: anObject ifAbsent: aBlock "remove the last element of the receiver equivalent to anObject." ^ self removeAtIndex: (self indexOfLast: anObject ifAbsent: [^ aBlock value])! replaceFrom: start with: replacementCollection "Replace the elements of the receiver from Integer indices start with the elements of the argument replacementCollection" | ix | ix := start - 1. replacementCollection do: [:repEle | self at: (ix := ix + 1) put: repEle]. ! replaceShiftFrom: from to: to with: aCollection startingAt: start "change the receiver such that it contains: (self at: 1)...(self at: from-1) (aCollection at: start+1)...(aCollection at: stop) (self at: to+1)...(self at: self size) Answer the receiver." | addSize | to < from - 1 ifTrue: [ ^ self replaceShiftFrom: from to: from - 1 with: aCollection startingAt: start]. (aCollection == self or: [aCollection = self elements]) ifTrue: [ ^ self replaceShiftFrom: from to: to with: (aCollection copyFrom: start to: aCollection size) startingAt: 1 to: aCollection size + 1 - start]. (addSize := (aCollection size - start) - (to - from)) > 0 ifTrue: [ self addAll: (1 to: addSize); replaceFrom: to addSize + 1 to: self size with: self startingAt: to + 1]. addSize < 0 ifTrue: [ self replaceFrom: to+1+addSize to: self+addSize with: self startingAt: to+1. self from: self size to: self size + addSize do: [:ele | self removeLast: ele]]. self replaceFrom: from to: to + addSize with: aCollection startingAt: start.! sequenceLess: aCollection "answer true if the receiver >, nil if equal, false if < than aCollection use sequence comparision" | comp | aCollection from: 1 to: (self size min: aCollection size) doWithIndex: [:anEle :anIx | (comp := (self at: anIx) sequenceLess: anEle) notNil ifTrue: [^ comp]]. ^ self size lssOP: aCollection size ! sort: sortBlock "sort the receiver by the sortBlock" self replaceFrom: 1 to: self size with: (self asSortedCollection: sortBlock) ! withPrefix: aPrefix "add aPrefix at the beginning of the receiver, if not already there, uppercase first element after prefix" | cat | ^ (self isSubCollection: aPrefix startingAt: 1) ifTrue: [self] ifFalse: [ cat := aPrefix, self. (self notEmpty and: [self first isCharacter]) ifTrue: [ cat at: aPrefix size + 1 put: self first asUppercase]. cat]! withSuffix: aSuffix "add aSuffix at the end of the receiver, if not already there" ^ (self isSubCollection: aSuffix startingAt: self size + 1 - aSuffix size) ifTrue: [self] ifFalse: [self, aSuffix]! ! !Set publicMethods ! isSameSet: aCollection "Answer whether the receiver and aCollection have the same elements ignoring occurrences" | set | ^ self size = (set := aCollection asSet) size and: [set conform: [:ele | self includes: ele]]! ! !SetWithEquality class publicMethods ! for: anObject ^ self new indexMap: (IndexMap for: anObject) ! test "SetPlus test" | a b c d x | ^ OrderedCollection new add: (Association key: 'a' value: (a := self new add: 'a'; add: 'eins'; addAll: #('eins' 'zwei' 'drei' 'vier'); yourself) printString, 'size', a size printString); add: (Association key: 'b' value: (b := a new addAll: #('b' 'eins' 'drei' 'fuenf'); yourself)); add: (Association key: 'c' value: (c := #('c' 'zwei' 'vier' 'sechs'))); add: (Association key: 'a uni b uni c ' value: (x := a union: (b union: c)) printString, ' size ', x size printString); add: (Association key: 'a inter b ' value: (a intersection: b)); add: (Association key: 'a inter c ' value: (a intersection: c)); add: (Association key: 'a - b ' value: (a difference: b)); add: (Association key: 'a - c ' value: (a difference: c)); add: (Association key: 'a includesAll b ' value: (a includesAll: b)); add: (Association key: '(d:=a copy) add b remove c ' value: ((d := a copy) addAll: b; removeAllPresent: c; yourself)); add: (Association key: 'd includesAll b ' value: (d includesAll: b)); add: (Association key: 'd includesAll c ' value: (d includesAll: c)); add: (Association key: 'a hash' value: a hash); add: (Association key: 'a copy hash' value: a copy hash); add: (Association key: '(a remove: ''a'') hash' value: (a remove: 'a'; yourself) hash); yourself! ! !SetWithEquality publicMethods ! = anObject ^ (self isCompatible: anObject) and: [self list = anObject list]! add: newObject self list: nil. ^ super add: newObject ! addAll: aCollection self list: nil. ^ super addAll: aCollection! basicNew ^ self speciesNew: 0! createList | arr index | arr := Array new: self size. index := 0. self indexMap isNil ifTrue: [self indexMap: IndexMap new]. super do: [:element | arr at: (index := index + 1) put: (indexMap indexAssociationAt: element)]. (arr asSortedCollection: [:a :b | a value <= b value]) doWithIndex: [:ass :ix | arr at: ix put: ass key]. self list: arr.! do: aBlock list isNil ifTrue: [super do: aBlock] ifFalse: [list do: aBlock]! hash ^ self list hash! indexMap ^ indexMap! indexMap: anObject indexMap := anObject.! initialize: anInteger self list: nil. super initialize: anInteger.! isCompatible: aCollection ^self class = aCollection class and: [self indexMap = aCollection indexMap]! list list isNil ifTrue: [self createList]. ^ list! list: anObject list := anObject.! new ^ self speciesNew: 0! new: newSize ^ self speciesNew: newSize! remove: oldObject self list: nil. ^ super remove: oldObject! remove: oldObject ifAbsent: anExceptionBlock ^ super remove: oldObject ifAbsent: [self list: nil. anExceptionBlock value]! removeAll: aCollection self list: nil. ^ super removeAll: aCollection! species ^self! speciesNew: size ^ (self class new: size) indexMap: self indexMap; yourself! ! !UndefinedObject publicMethods ! assert: aBlock aBlock value ifFalse: [self halt: 'assertion failed']! fail: aString self halt: 'assertion failed: ', aString asString! isCollection "Answer whether the receiver is a collection" ^false! printDetailsOn: aStream ! printIdOn: aStream ^ self printOn: aStream! showString ^ self printString! ! !WriteStream publicMethods ! currentPut: anObject "Store the argument anObject at the current position overwriting the last element put into the receiver" ^collection at: position put: anObject! printId: anObject anObject printOn: self! ! !WriteStreamPlus class publicMethods ! new ^ super new printIdBlockDefault; isStoppedBlockFalse; intendation: ''; yourself! ! !WriteStreamPlus publicMethods ! cr "Store the cr (carriage return) character as the next object in the receiver. Answer self. Set the receiver's position reference to be immediately after the cr character." super cr. self nextPutAll: self intendation.! intendation ^ intendation! intendation: anObject intendation := anObject.! isStopped: anObject "answer true if object is stopped" ^ self isStoppedBlock value: anObject! isStoppedBlock ^ isStoppedBlock! isStoppedBlock: anObject isStoppedBlock := anObject.! isStoppedBlockFalse "set a stop block that never stops an object" self isStoppedBlock: [:obj | false]! isStoppedBlockOnceOnly "set a stop block that never stops an object after the first time" | stopper | stopper := Set new. self isStoppedBlock: [:obj | (stopper includes: obj) ifFalse: [stopper add: obj. false] ifTrue: [true]]! left self intendation: (self intendation copyFrom: 1 to: self intendation size - 1)! printBlockString: nameBlock "answer the string that the one one argument block nameBlock would print to the receiver but do not change the receiver" | index string | index := self position. nameBlock value: self. string := self contents copyFrom: index+1 to: self position. self position: index. ^ string ! printDetails: anObject "if not stopped print anObject on a new line with unique Identification, statistic line and if not stopped as 0 to n detail lines" (self isStopped: anObject) ifFalse: [self printDetailsAlways: anObject]! printDetailsAlways: anObject "unconditionally print anObject on a new line with unique Identification, statistic line and if not stopped as 0 to n detail lines" self cr; printStats: anObject; printDetailsOnly: anObject! printDetailsOnly: anObject "print 0 to n detail lines of anObject" self right. anObject printDetailsOn: self. self left.! printDetailsOrStats: anObject "print stats on a new line with unique Identification and if not stopped 0 to n detail lines" self printStats: anObject. (self isStopped: anObject) ifFalse: [ self printDetailsOnly: anObject]! printId: anObject "print anObject, with unique Identification " self printIdBlock value: self value: anObject value: [:stream | anObject printOn: stream]! printId: anObject put: nameBlock "if it does not exist yet, create the unique identification for anObject by using the nameBlock. donot print anything to the receiver" | index | index := self position. self printIdBlock value: self value: anObject value: nameBlock. self position: index. ! printIdAll: aCollection "print the id's of the collection elements " | first | self nextPut: $(. first := true. aCollection do: [:ele | first ifTrue: [first := false] ifFalse: [self space]. self printId: ele]. self nextPut: $).! printIdBlock ^ printIdBlock! printIdBlock: anObject printIdBlock := anObject.! printIdBlockCounter "set a printIdBlock which prints anObject, with a a unique number appended do not use self, so we may transfer the block to another stream!! " | objDict counter | objDict = IdentityDictionary new. counter := 0. self printIdBlock: [:stream :obj :nameBlock | stream nextPutAll: (objDict at: obj ifAbsentPut: [nameBlock value, '/', (counter := counter + 1) printString])] ! printIdBlockDefault "set a printIdBlock which prints anObject with printOn: do not use self, so we may transfer the block to another stream!! " self printIdBlock: [:stream :obj :nameBlock | obj printOn: stream] ! printIdBlockDuplicateResolver "set a printIdBlock which prints anObject, with a duplicate resolver if necessary do not use self, so we may transfer the block to another stream!! " | objDict nameDict | objDict := Dictionary new. nameDict := Dictionary new. self printIdBlock: [:stream :obj :nameBlock | | name index | stream nextPutAll: (objDict at: obj ifAbsent: [ "not ifAbsentPut here, because of recursive updates of objDict!! " name := self printBlockString: nameBlock. (index := nameDict at: name put: 1 + (nameDict at: name ifAbsent: [0])) = 1 ifFalse: [name := name, '/', index printString]. objDict at: obj ifAbsentPut: [name]])] ! printIdString: anObject "answer the string that would be printed by printId: but do not change the receiver " ^ self printBlockString: [:stream | stream printId: anObject]! printStats: anObject "print anObject, with unique Identification and statistic line " | lastPos | lastPos := self printId:anObject; nextPut: $(; position. anObject printStatsOn: self. lastPos < self position ifTrue: [self nextPut: $)] ifFalse: [self position: lastPos - 1]! right self intendation: self intendation, Tab asString! ! !ZwkExtensions class publicMethods ! loaded self reset. ! removing "The default behavior for the receiver before it is to be removed is to do nothing. Override this method to eliminate any instances of its classes that may exist in known class, pool or global variables. NOTE: #failedRemove will be called if the receiver was unable to be removed." self reset. ! reset IndexMap reset. ! testNextWord "ZwkExtensions testNextWord" | str co | str := ReadStream on: 'wie geht''s Dir heute, oder lineDelimiter bist du noch nicht wach ?'. co := OrderedCollection with: str contents. [str atEnd] whileFalse: [co add: str nextWord]. ^ co! testNextWordOrEol "ZwkExtensions testNextWordOrEol" | str co | str := ReadStream on: 'wie geht''s Dir heute, oder lineDelimiter bist du noch nicht wach ? '. co := OrderedCollection with: str contents. [str atEnd] whileFalse: [co add: str nextWordOrEol]. ^ co! testNextWordOrLineDelimiter "ZwkExtensions testNextWord" | str co | str := ReadStream on: 'wie geht''s Dir heute, oder lineDelimiter bist du noch nicht wach ? '. co := OrderedCollection with: str contents. [str atEnd] whileFalse: [co add: str nextWordOrLineDelimiter]. ^ co! ! Graph initializeAfterLoad! SetWithEquality initializeAfterLoad! GraphElement initializeAfterLoad! GraphArc initializeAfterLoad! GraphNode initializeAfterLoad! GraphSearch initializeAfterLoad! GraphSearchVia initializeAfterLoad! GraphSearchMap initializeAfterLoad! IndexMap initializeAfterLoad! WriteStreamPlus initializeAfterLoad! ZwkExtensions initializeAfterLoad! ZwkExtensions loaded!