"{ Package: 'stx:libbasic2' }"

"{ NameSpace: Smalltalk }"

Object subclass:#FuzzyMatcher

	instanceVariableNames:'pattern lowercasePattern indexes'

	classVariableNames:''

	poolDictionaries:''

	category:'Collections-Text-Support'

!

!FuzzyMatcher class methodsFor:'documentation'!

documentation

"

    FuzzyMatcher is an approximate string matching algorithm that can determine if a string includes a given pattern.

    For example, the string 'axby' matches both the pattern 'ab' and, 'ay', but not 'ba'. 

    The algorithm is based on lib_fts[1], and includes an optional scoring algorithm 

    that can be used to sort all the matches based on their similarity to the pattern.

    It is used in the sublime text editor.

    [see also:]

        https://blog.forrestthewoods.com/reverse-engineering-sublime-text-s-fuzzy-match-4cffeed33fdb

        https://github.com/forrestthewoods/lib_fts

"

!

example

"

    |top lv list field patternHolder names|

    patternHolder := '' asValue.

    list := List new.

    top := StandardSystemView new.

    lv := ListView origin:(0.0@30) corner:(1.0@1.0) in:top.

    lv model:list.

    field := EditField origin:(0.0@0.0) corner:(1.0@30) in:top.

    field model:patternHolder.

    field immediateAccept:true.

    names := Smalltalk allClasses collect:#name.

    patternHolder 

        onChangeEvaluate:[

            |matcher pattern matches|

            pattern := patternHolder value.

            pattern notEmpty ifTrue:[

                matcher := FuzzyMatcher pattern:pattern.

                matches := OrderedCollection new.

                names do:[:eachClassName | 

                    matcher 

                        match:eachClassName

                        ifScored: [ :score | matches add: eachClassName -> score ] 

                ].

                matches sort:[:a :b |

                        a value < b value

                        or:[ a value = b value and:[ a key > b key]]

                ].

                list removeAll.

                list addAllReversed:(matches 

                                collect:[:nameScoreAssoc | 

                                    '[%1] %2' bindWith:nameScoreAssoc value with:nameScoreAssoc key])

            ].    

        ].    

    top open.

    patternHolder value:'mph'.

"

! !

!FuzzyMatcher class methodsFor:'instance creation'!

new

    "return an initialized instance"

    ^ self basicNew initialize.

!

pattern: aString

    ^ self new pattern: aString

    "

     (self pattern:'mrp') matches:'ButtonMorph'

    "

    "Modified (comment): / 14-07-2017 / 15:02:43 / cg"

! !

!FuzzyMatcher class methodsFor:'utilities api'!

allMatching: aPattern in: aCollection

    "Assumes that the collection is a collection of Strings"

    | matcher |

    matcher := self pattern: aPattern.

    ^ aCollection select: [ :each | matcher matches: each ]

    "

     self 

        allMatching:'clu' 

        in:(Smalltalk allClasses collect:#name)

    "

    "Modified (comment): / 14-07-2017 / 12:19:05 / cg"

!

allMatching: aPattern in: aCollection by: aBlockReturningString

    "selects matching elements from aCollection.

     aBlockReturningString is applied to elements to get the string representation

     (can be used eg. to sort classes)"

    | matcher |

    matcher := self pattern: aPattern.

    ^ aCollection select: [ :each | matcher matches: (aBlockReturningString value: each) ]

        "

         self 

            allMatching:'clu' 

            in:(Smalltalk allClasses)

            by:[:cls | cls name]

        "

        "

         self 

            allMatching:'clu' 

            in:(Smalltalk allClasses)

            by:#name

        "

    "Modified (comment): / 14-07-2017 / 12:21:40 / cg"

!

allSortedByScoreMatching: aPattern in: aCollection

    "Assumes that the collection is a collection of Strings;

     returns matching strings sorted by score (level of similarity)"

    ^ self allSortedByScoreMatching: aPattern in: aCollection by: [ :each | each ]

    "

     self 

        allSortedByScoreMatching:'clu' 

        in:(Smalltalk allClasses collect:#name)

    "

    "

     self 

        allSortedByScoreMatching:'nary' 

        in:(Smalltalk allClasses collect:#name)

    "

    "Modified (comment): / 14-07-2017 / 12:22:14 / cg"

!

allSortedByScoreMatching: aPattern in: aCollection by: aBlockReturningString

    "selects matching elements from aCollection.

     aBlockReturningString is applied to elements to get the string representation.

     Returns them sorted by score (i.e. similarity).

     (can be used eg. to sort classes)"

    | matchesAndScores |

    matchesAndScores := self allWithScoresSortedByScoreMatching: aPattern in: aCollection by: aBlockReturningString.

    ^ matchesAndScores collect: [ :each | each value ]

    "

     self 

        allSortedByScoreMatching:'' 

        in:(Smalltalk allClasses)

        by:[:cls | cls name]

    "

    "

     self 

        allSortedByScoreMatching:'nary' 

        in:(Smalltalk allClasses)

        by:[:cls | cls name]

    "

    "

     self 

        allSortedByScoreMatching:'nary' 

        in:(Smalltalk allClasses)

        by:#name

    "

    "Modified: / 14-07-2017 / 12:43:14 / cg"

!

allWithScoresSortedByScoreMatching: aPattern in: aCollection by: aBlockReturningString

    "selects matching elements from aCollection.

     aBlockReturningString is applied to elements to get the string representation.

     Returns them sorted by score (i.e. similarity) associated to their scores.

     (can be used eg. to sort classes)"

    |matcher matches|

    matcher := self pattern: aPattern.

    matches := OrderedCollection new: aCollection size // 2.

    aCollection do: [ :each | 

        matcher 

            match: (aBlockReturningString value: each) 

            ifScored: [ :score | matches add: score -> each ] 

    ].

    matches sort: [ :a :b | a key > b key].

    ^ matches asArray

    "

     self 

        allWithScoresSortedByScoreMatching:'' 

        in:(Smalltalk allClasses)

        by:[:cls | cls name]

    "

    "

     self 

        allWithScoresSortedByScoreMatching:'OC' 

        in:(Smalltalk allClasses)

        by:[:cls | cls name]

    "

    "

     self 

        allWithScoresSortedByScoreMatching:'nary' 

        in:(Smalltalk allClasses)

        by:[:cls | cls name]

    "

    "

     self 

        allWithScoresSortedByScoreMatching:'nary' 

        in:(Smalltalk allClasses)

        by:#name

    "

    "Created: / 14-07-2017 / 12:25:19 / cg"

! !

!FuzzyMatcher methodsFor:'accessing'!

pattern

	^ pattern 

!

pattern: aString

        pattern := aString.

        lowercasePattern := pattern asLowercase.

        indexes := Array new: pattern size.

    "Modified (format): / 14-07-2017 / 12:59:15 / cg"

! !

!FuzzyMatcher methodsFor:'comparing'!

match: aString ifScored: aBlock

        | score |

        pattern ifEmpty: [ aBlock value: "0" aString size negated. ^ self ].

        (self matches: aString) ifFalse: [ ^ self ].

        score := self firstScore: aString at: indexes first.

        2 to: pattern size do: [ :pix | 

                score := score + (self score: aString at: (indexes at: pix) patternAt: pix)

        ].

        score := score + self indexScore + ((aString size - pattern size) * self unmatchedLetterPenalty).

        aBlock value: score.

    "Modified: / 14-07-2017 / 12:44:50 / cg"

!

matches: aString

	| idx |

	pattern size > aString size ifTrue: [ ^ false ].

	idx := 0.

	pattern withIndexDo: [ :each :i |

		idx := aString 

			findString: each asString 

			startingAt: idx + 1 

			caseSensitive: false. 

		idx == 0 ifTrue: [ ^ false ].

		indexes at: i put: idx.

	].

	^ true

! !

!FuzzyMatcher methodsFor:'initialization'!

initialize

        super initialize.

        pattern := lowercasePattern := ''.

        indexes := #().

    "Modified (format): / 14-07-2017 / 13:23:26 / cg"

! !

!FuzzyMatcher methodsFor:'private'!

firstScore: aString at: anIndex

	| score |

	score := (aString at: anIndex) = pattern first 

		ifTrue: [ self caseEqualBonus ]

		ifFalse: [ 0 ].

	anIndex = 1 	ifTrue: [ ^ score + self firstLetterBonus ].

	score := score + (((anIndex - 1) * self leadingLetterPenalty) max: self maxLeadingLetterPenalty).

	^ score 

!

indexScore 

        | sum ramp |

        ramp := 1.

        sum := 0.

        1 to: indexes size - 1 do: [ :ix |

                ramp := (indexes at: ix) + 1 = (indexes at: ix + 1) 

                        ifTrue: [ ramp + (ramp * self adjacencyIncrease) ]

                        ifFalse: [ 1 ].                 

                sum := sum + ramp - 1

        ].

        ^ sum rounded

    "Modified (format): / 14-07-2017 / 13:24:07 / cg"

!

isSeparator: aCharacter

        ^  aCharacter = $_ or: [ aCharacter = $: ]

    "Created: / 13-07-2017 / 13:30:34 / cg"

!

isSeperator: aCharacter

        <resource: #obsolete>

        ^ self isSeparator: aCharacter

    "Modified: / 13-07-2017 / 13:31:18 / cg"

!

score: aString at: stringIndex patternAt: patternIndex

        | score prev |

        prev := (aString at: stringIndex - 1).

        score := (self isSeparator: prev) 

                ifTrue: [ self separatorBonus ]

                ifFalse: [ (prev asLowercase = (lowercasePattern at: patternIndex - 1))

                        ifTrue: [ 

                                self adjacencyBonus + 

                                ((prev = (pattern at: patternIndex - 1)) ifTrue: [ self adjacentCaseEqualBonus ] ifFalse: [ 0 ]) 

                        ] 

                        ifFalse: [ 0 ] 

                ].

        (aString at: stringIndex) = (pattern at: patternIndex) ifTrue: [ 

                score := score + self caseEqualBonus.

        ].

        ^ score

    "Modified: / 13-07-2017 / 13:30:57 / cg"

! !

!FuzzyMatcher methodsFor:'scoring-bonus'!

adjacencyBonus

	^ 5

!

adjacencyIncrease

	^ 1.2

!

adjacentCaseEqualBonus

	^ 3

!

caseEqualBonus

	^ 7

!

firstLetterBonus

	^ 12

!

separatorBonus

	^ 5

! !

!FuzzyMatcher methodsFor:'scoring-penalty'!

leadingLetterPenalty

	^ -3

!

maxLeadingLetterPenalty

	^ -9

!

unmatchedLetterPenalty

	^ -1

! !

!FuzzyMatcher class methodsFor:'documentation'!

version

    ^ '$Header$'

!

version_CVS

    ^ '$Header$'

! !