SystemOrganization addCategory: #'PageRank-Core'! SystemOrganization addCategory: #'PageRank-Tests'! Object subclass: #PageRank instanceVariableNames: 'damping iterations stepBlock referencedBlock' classVariableNames: '' poolDictionaries: '' category: 'PageRank-Core'! !PageRank class methodsFor: 'instance creation' stamp: 'lr 7/12/2010 06:42'! new ^ self basicNew initialize! ! !PageRank methodsFor: 'accessing' stamp: 'lr 7/12/2010 06:42'! damping: aNumber "The damping factor represents the probability the flow will continue at any step. The default value is 0.85." damping := aNumber asFloat! ! !PageRank methodsFor: 'initialization' stamp: 'lr 7/12/2010 06:51'! initialize self iterations: 100; damping: 0.85. self referenced: [ :node | #() ]. self step: [ :iteration | ]! ! !PageRank methodsFor: 'accessing' stamp: 'lr 7/12/2010 06:36'! iterations: anInteger "The number of iterations defines how many times the calculation is repeated, more iterations give more accurate results. The default value is 100." iterations := anInteger asInteger! ! !PageRank methodsFor: 'private' stamp: 'lr 7/12/2010 06:51'! mappingFor: aCollection | sentinel nodes | sentinel := Object new. nodes := IdentityDictionary new: aCollection size. aCollection do: [ :node | nodes at: node put: PageRankNode new ]. nodes keysAndValuesDo: [ :node :item | item nodes: (((referencedBlock value: node) collect: [ :each | nodes at: each ifAbsent: [ sentinel ] ]) reject: [ :each | each == sentinel or: [ each == node ] ]); previous: 1.0 / aCollection size; current: 1.0 - damping ]. ^ nodes! ! !PageRank methodsFor: 'accessing' stamp: 'lr 7/12/2010 06:51'! referenced: aOneArgumentBlock "Defines how the referenced nodes of a given element are retrieved." referencedBlock := aOneArgumentBlock! ! !PageRank methodsFor: 'public' stamp: 'lr 7/12/2010 06:36'! runOn: aCollection | nodes items inverse | nodes := self mappingFor: aCollection. items := nodes values asArray. inverse := 1.0 - damping. 1 to: iterations do: [ :counter | items do: [ :node | node nodes do: [ :child | child accumulate: (damping * node previous / node nodes size) ] ]. items do: [ :item | item reset: inverse ]. stepBlock value: counter ]. nodes associationsDo: [ :assoc | assoc value: assoc value previous ]. ^ nodes! ! !PageRank methodsFor: 'accessing' stamp: 'lr 7/12/2010 06:32'! step: aOneArgumentBlock "The block evaluated with each iteration step." stepBlock := aOneArgumentBlock! ! Object subclass: #PageRankExample instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PageRank-Tests'! !PageRankExample methodsFor: 'examples' stamp: 'lr 7/13/2010 19:45'! importantClassesIn: aBrowserEnvironment "self new importantClassesIn: (BrowserEnvironment new)" "self new importantClassesIn: (BrowserEnvironment new forPackageNames: #('VB-Regex'))" | graph ranks result | graph := IdentityDictionary new. aBrowserEnvironment classesAndSelectorsDo: [ :class :selector | class isTrait ifFalse: [ | collection | collection := graph at: class theNonMetaClass name ifAbsentPut: [ class theNonMetaClass superclass isNil ifTrue: [ OrderedCollection new ] ifFalse: [ OrderedCollection with: class theNonMetaClass superclass name ] ]. ((class compiledMethodAt: selector) literals allButLast: 2) do: [ :each | (each isVariableBinding and: [ each key isSymbol ]) ifTrue: [ collection add: each key ] ] ] ]. ranks := PageRank new referenced: [ :each | graph at: each ]; runOn: graph keys. result := (graph keys asSortedCollection: [ :a :b | (ranks at: a) >= (ranks at: b) ]) collect: [ :each | each -> (ranks at: each) ]. ^ result! ! !PageRankExample methodsFor: 'examples' stamp: 'lr 7/13/2010 19:50'! importantObjects "self new importantObjects" | objects | Smalltalk garbageCollect. objects := OrderedCollection withAll: (-1024 to: 1024). self systemNavigation allObjectsDo: [ :each | (objects == each or: [ objects collector == each ]) ifFalse: [ objects addLast: each ] ]. ^ self importantObjectsIn: objects asArray! ! !PageRankExample methodsFor: 'examples' stamp: 'lr 7/13/2010 19:51'! importantObjectsIn: anArray "self new importantObjects inspect" | graph ranks | graph := IdentityDictionary new: anArray size. anArray do: [ :each | | children | children := OrderedCollection new. each class isVariable ifTrue: [ 1 to: each basicSize do: [ :index | children add: (each basicAt: index) ] ]. 1 to: each class instSize do: [ :index | children add: (each instVarAt: index) ]. graph at: each put: children asArray ]. ranks := PageRank new nodes: [ :each | graph at: each ifAbsent: [ #() ] ]; runOn: anArray. ^ anArray sort: [ :a :b | (ranks at: a) >= (ranks at: b) ]! ! !PageRankExample methodsFor: 'examples' stamp: 'lr 7/13/2010 19:47'! importantSelectorsIn: aBrowserEnvironment "self new importantSelectorsIn: (BrowserEnvironment new)" "self new importantSelectorsIn: (BrowserEnvironment new forPackageNames: #('VB-Regex'))" | graph ranks result | graph := IdentityDictionary new. aBrowserEnvironment classesAndSelectorsDo: [ :class :selector | | collection method | collection := graph at: selector ifAbsentPut: [ OrderedCollection new ]. method := class compiledMethodAt: selector. method primitive = 0 ifTrue: [ method messagesDo: [ :each | each isSymbol ifTrue: [ collection add: each ] ] ] ]. ranks := PageRank new referenced: [ :each | graph at: each ifAbsent: [ #() ] ]; runOn: graph keys. result := (graph keys asSortedCollection: [ :a :b | (ranks at: a) >= (ranks at: b) ]) collect: [ :each | each -> (ranks at: each) ]. ^ result! ! Object subclass: #PageRankNode instanceVariableNames: 'nodes previous current' classVariableNames: '' poolDictionaries: '' category: 'PageRank-Core'! !PageRankNode methodsFor: 'public' stamp: 'lr 7/10/2010 10:56'! accumulate: aNumber current := current + aNumber! ! !PageRankNode methodsFor: 'accessing' stamp: 'lr 7/10/2010 10:48'! current ^ current! ! !PageRankNode methodsFor: 'accessing' stamp: 'lr 7/10/2010 10:58'! current: aNumber current := aNumber! ! !PageRankNode methodsFor: 'accessing' stamp: 'lr 7/12/2010 06:37'! nodes ^ nodes! ! !PageRankNode methodsFor: 'accessing' stamp: 'lr 7/12/2010 06:37'! nodes: aCollection nodes := aCollection asArray! ! !PageRankNode methodsFor: 'accessing' stamp: 'lr 7/10/2010 10:48'! previous ^ previous! ! !PageRankNode methodsFor: 'accessing' stamp: 'lr 7/10/2010 10:58'! previous: aNumber previous := aNumber! ! !PageRankNode methodsFor: 'public' stamp: 'lr 7/10/2010 10:56'! reset: aNumber previous := current. current := aNumber! ! TestCase subclass: #PageRankTest instanceVariableNames: 'graph ranks ranker' classVariableNames: '' poolDictionaries: '' category: 'PageRank-Tests'! !PageRankTest methodsFor: 'running' stamp: 'lr 7/12/2010 06:51'! setUp super setUp. graph := Dictionary new. graph at: #a put: #(c). graph at: #b put: #(a). graph at: #c put: #(a). graph at: #d put: #(c b). ranker := PageRank new. ranker referenced: [ :node | graph at: node ]! ! !PageRankTest methodsFor: 'tests' stamp: 'lr 7/12/2010 06:46'! testFirstStep ranker iterations: 1; damping: 1. ranks := ranker runOn: graph keys. self assert: ((ranks at: #a) closeTo: 0.5). self assert: ((ranks at: #b) closeTo: 0.125). self assert: ((ranks at: #c) closeTo: 0.375). self assert: ((ranks at: #d) closeTo: 0.0).! ! !PageRankTest methodsFor: 'tests' stamp: 'lr 7/12/2010 06:46'! testInitialStep ranker iterations: 0; damping: 1. ranks := ranker runOn: graph keys. self assert: ((ranks at: #a) closeTo: 0.25). self assert: ((ranks at: #b) closeTo: 0.25). self assert: ((ranks at: #c) closeTo: 0.25). self assert: ((ranks at: #d) closeTo: 0.25).! ! !PageRankTest methodsFor: 'tests' stamp: 'lr 7/12/2010 06:45'! testSecondStep ranker iterations: 2; damping: 1. ranks := ranker runOn: graph keys. self assert: ((ranks at: #a) closeTo: 0.5). self assert: ((ranks at: #b) closeTo: 0.0). self assert: ((ranks at: #c) closeTo: 0.5). self assert: ((ranks at: #d) closeTo: 0.0).! ! !PageRankTest methodsFor: 'tests' stamp: 'lr 7/12/2010 06:51'! testSelfReference | result | result := ranker referenced: [ :node | #(a) ]; runOn: #(a). self assert: (result size) = 1. self assert: (result at: #a) > 0! ! !PageRankTest methodsFor: 'tests' stamp: 'lr 7/12/2010 06:51'! testSingleNode | result | result := ranker referenced: [ :node | #() ]; runOn: #(a). self assert: (result size) = 1. self assert: ((result at: #a) closeTo: 0.15)! ! !PageRankTest methodsFor: 'tests' stamp: 'lr 7/12/2010 06:38'! testStepping | stepping | stepping := OrderedCollection new. ranker iterations: 5; step: [ :value | stepping addLast: value ]; runOn: graph keys. self assert: stepping size = 5. self assert: stepping first = 1. self assert: stepping last = 5! ! !PageRankTest methodsFor: 'tests' stamp: 'lr 7/12/2010 06:51'! testTwoNodeLoop | result | result := ranker referenced: [ :node | node = #a ifTrue: [ #(b) ] ifFalse: [ #(a) ] ]; runOn: #(a b). self assert: (result size) = 2. self assert: ((result at: #a) closeTo: 1.0). self assert: ((result at: #b) closeTo: 1.0)! !