"{ 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'. 

    I.e. it matches if the searched string contains a sequence of chars, probably intermixed by other chars,

    which matches the given search pattern or part of it.

    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 (among others) in the sublime text editor.

    [caveat:]

        although this works great for class searches,

        it is strange that 'dabc' scores lower against 'abc' than 'adbc'

        (dabc has a longer common subsequence without interruptions...)

    [see also:]

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

        https://github.com/forrestthewoods/lib_fts

"

!

example

"

    |matcher|

    matcher := FuzzyMatcher pattern:'abc'.

    matcher 

        match:'somearbitrarysequence'   

        ifScored: [:score | Transcript show:('''somearbitrarysequence'' scores '); showCR:score].

    matcher 

        match:'someabcd'   

        ifScored: [:score | Transcript show:('''someabcd'' scores '); showCR:score].

    matcher 

        match:'abcd'   

        ifScored: [:score | Transcript show:('''abcd'' scores '); showCR:score].

    matcher 

        match:'dabc'   

        ifScored: [:score | Transcript show:('''dabc'' scores '); showCR:score].

    matcher 

        match:'adbc'   

        ifScored: [:score | Transcript show:('''adbc'' scores '); showCR:score].

    matcher 

        match:'abc'   

        ifScored: [:score | Transcript show:('''abc'' scores '); showCR:score].

    |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'

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

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

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

    "

    "Modified (comment): / 02-08-2017 / 15:57:07 / cg"

! !

!FuzzyMatcher class methodsFor:'utilities api'!

allMatching: aPattern in: aCollection

    "Assumes that the collection is a collection of Strings;

     return all those which match"

    | matcher |

    matcher := self pattern: aPattern.

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

    "

     self 

        allMatching:'clu' 

        in:(Smalltalk allClasses collect:#name)

    "

    "Modified (comment): / 02-08-2017 / 16:02:44 / 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'!

indexes

    "only valid inside the match callback block"

    ^ indexes

    "Created: / 15-07-2017 / 14:57:10 / cg"

!

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:'api - comparing'!

match: aString ifScored: aBlock

    "If there is a match, evaluate aBlock, passing the score value"

    | scoreOrNil |

    scoreOrNil := self matchScoreOrNil: aString.

    scoreOrNil notNil ifTrue:[

        aBlock value:scoreOrNil

    ].

    "Modified: / 02-08-2017 / 16:00:59 / cg"

!

matchScoreOrNil: aString

    "return the scrore if there is a match; nil otherwise."

    | score |

    pattern ifEmpty: [ ^ (aString size negated) ].

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

    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).

    ^ score.

    "Created: / 02-08-2017 / 15:59:56 / cg"

!

matches: aString

    "return true if there is a match; false otherwise."

    | 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

    "Modified (format): / 02-08-2017 / 16:01:05 / cg"

! !

!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"

!

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$'

! !