SystemOrganization addCategory: #'PageRank-Core'! SystemOrganization addCategory: #'PageRank-Tests'! Object subclass: #PageRanker instanceVariableNames: 'damping iterations outlinks stepBlock stepper' classVariableNames: '' poolDictionaries: '' category: 'PageRank-Core'! !PageRanker methodsFor: 'accessing' stamp: 'lr 7/9/2010 11:03'! damping: aNumber "The damping factor represents the probability the flow will continue at any step. The deafult value is 0.85." damping := aNumber asFloat! ! !PageRanker methodsFor: 'initialization' stamp: 'lr 7/10/2010 18:27'! initialize self iterations: 100; damping: 0.85. self outlinks: [ :node | #() ]. self stepper: [ :count | ]! ! !PageRanker methodsFor: 'accessing' stamp: 'lr 7/9/2010 11:07'! 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! ! !PageRanker methodsFor: 'private' stamp: 'lr 7/10/2010 11:05'! mappingFor: aCollection | zork nodes | zork := Object new. nodes := IdentityDictionary new: aCollection size. aCollection do: [ :node | nodes at: node put: PageRankerItem new ]. nodes keysAndValuesDo: [ :node :item | item outlinks: (((outlinks value: node) collect: [ :each | nodes at: each ifAbsent: [ zork ] ]) reject: [ :each | each == zork or: [ each == node ] ]); previous: 1.0 / aCollection size; current: 1.0 - damping ]. ^ nodes! ! !PageRanker methodsFor: 'accessing' stamp: 'lr 7/9/2010 11:09'! outlinks: aBlock "Defines how the children of a given element are retrieved." outlinks := aBlock! ! !PageRanker methodsFor: 'public' stamp: 'lr 7/10/2010 18:26'! runOn: aCollection | nodes items inverse | nodes := self mappingFor: aCollection. items := nodes values asArray. inverse := 1.0 - damping. 1 to: iterations do: [ :counter | items do: [ :item | item outlinks do: [ :child | child accumulate: (damping * item previous / item outlinks size) ] ]. items do: [ :item | item reset: inverse ]. stepper value: counter ]. nodes associationsDo: [ :assoc | assoc value: assoc value previous ]. ^ nodes! ! !PageRanker methodsFor: 'accessing' stamp: 'lr 7/10/2010 18:27'! stepper: aOneArgumentBlock "The block evaluated with each iteration step." stepper := aOneArgumentBlock! ! Object subclass: #PageRankerExample instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PageRank-Tests'! !PageRankerExample methodsFor: 'examples' stamp: 'lr 7/11/2010 11:12'! importantClassesIn: aBrowserEnvironment "self new importantClassesIn: (BrowserEnvironment new)" "self new importantClassesIn: (BrowserEnvironment new forPackageNames: #('TextLint-Model'))" | graph ranks result | graph := IdentityDictionary new. aBrowserEnvironment classesAndSelectorsDo: [ :class :selector | | collection | class isTrait ifFalse: [ collection := graph at: class theNonMetaClass name ifAbsentPut: [ class superclass isNil ifTrue: [ IdentitySet new ] ifFalse: [ IdentitySet with: class superclass name ] ]. ((class compiledMethodAt: selector) literals allButLast: 2) do: [ :each | (each isVariableBinding and: [ each key isSymbol ]) ifTrue: [ collection add: each key ] ] ] ]. ranks := PageRanker new stepper: [ :each | Transcript show: '.' ]; outlinks: [ :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! ! !PageRankerExample methodsFor: 'examples' stamp: 'lr 7/10/2010 18:28'! importantObjects "self new importantObjects" | objects | Smalltalk garbageCollect. objects := OrderedCollection new. self systemNavigation allObjectsDo: [ :each | (objects == each or: [ objects collector == each ]) ifFalse: [ objects addLast: each ] ]. ^ self importantObjectsIn: objects asArray! ! !PageRankerExample methodsFor: 'examples' stamp: 'lr 7/10/2010 18:29'! importantObjectsIn: anArray "(self new importantObjects first: 100) inspect" | graph ranks result | 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 := PageRanker new stepper: [ :count | Transcript show: count; cr ]; outlinks: [ :each | graph at: each ifAbsent: [ #() ] ]; runOn: anArray. ^ anArray sort: [ :a :b | (ranks at: a) >= (ranks at: b) ]! ! !PageRankerExample methodsFor: 'examples' stamp: 'lr 7/11/2010 11:12'! importantSelectorsIn: aBrowserEnvironment "self new importantSelectorsIn: (BrowserEnvironment new)" "self new importantSelectorsIn: (BrowserEnvironment new forPackageNames: #('TextLint-Model'))" | graph ranks result primitives | 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 := PageRanker new stepper: [ :each | Transcript show: '.' ]; outlinks: [ :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: #PageRankerItem instanceVariableNames: 'outlinks previous current' classVariableNames: '' poolDictionaries: '' category: 'PageRank-Core'! !PageRankerItem methodsFor: 'public' stamp: 'lr 7/10/2010 10:56'! accumulate: aNumber current := current + aNumber! ! !PageRankerItem methodsFor: 'accessing' stamp: 'lr 7/10/2010 10:48'! current ^ current! ! !PageRankerItem methodsFor: 'accessing' stamp: 'lr 7/10/2010 10:58'! current: aNumber current := aNumber! ! !PageRankerItem methodsFor: 'accessing' stamp: 'lr 7/10/2010 10:48'! outlinks ^ outlinks! ! !PageRankerItem methodsFor: 'accessing' stamp: 'lr 7/10/2010 10:58'! outlinks: aCollection outlinks := aCollection asArray! ! !PageRankerItem methodsFor: 'accessing' stamp: 'lr 7/10/2010 10:48'! previous ^ previous! ! !PageRankerItem methodsFor: 'accessing' stamp: 'lr 7/10/2010 10:58'! previous: aNumber previous := aNumber! ! !PageRankerItem methodsFor: 'public' stamp: 'lr 7/10/2010 10:56'! reset: aNumber previous := current. current := aNumber! ! TestCase subclass: #PageRankerTest instanceVariableNames: 'graph ranks ranker' classVariableNames: '' poolDictionaries: '' category: 'PageRank-Tests'! !PageRankerTest methodsFor: 'as yet unclassified' stamp: 'lr 7/9/2010 11:16'! 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 := PageRanker new. ranker outlinks: [ :node | graph at: node ]! ! !PageRankerTest methodsFor: 'as yet unclassified' stamp: 'lr 7/9/2010 11:21'! testFirstStep ranker iterations: 1; damping: 1. ranks := ranker runOn: graph keys. self assert: (ranks at: #a) = 0.5. self assert: (ranks at: #b) = 0.125. self assert: (ranks at: #c) = 0.375. self assert: (ranks at: #d) = 0.0.! ! !PageRankerTest methodsFor: 'as yet unclassified' stamp: 'lr 7/9/2010 11:21'! testInitialStep ranker iterations: 0; damping: 1. ranks := ranker runOn: graph keys. self assert: (ranks at: #a) = 0.25. self assert: (ranks at: #b) = 0.25. self assert: (ranks at: #c) = 0.25. self assert: (ranks at: #d) = 0.25.! ! !PageRankerTest methodsFor: 'as yet unclassified' stamp: 'lr 7/9/2010 11:22'! testSecondStep ranker iterations: 2; damping: 1. ranks := ranker runOn: graph keys. self assert: (ranks at: #a) = 0.5. self assert: (ranks at: #b) = 0.0. self assert: (ranks at: #c) = 0.5. self assert: (ranks at: #d) = 0.0.! !