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

! !

!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

    | 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

        "

!

allSortedByScoreMatching: aPattern in: aCollection

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

    "

     self 

        allSortedByScoreMatching:'clu' 

        in:(Smalltalk allClasses collect:#name)

    "

    "

     self 

        allSortedByScoreMatching:'nary' 

        in:(Smalltalk allClasses collect:#name)

    "

!

allSortedByScoreMatching: aPattern in: aCollection by: aBlockReturningString

    "

     self 

        allSortedByScoreMatching:'nary' 

        in:(Smalltalk allClasses)

        by:[:cls | cls name]

    "

    "

     self 

        allSortedByScoreMatching:'nary' 

        in:(Smalltalk allClasses)

        by:#name

    "

! !

!FuzzyMatcher methodsFor:'accessing'!

pattern

	^ pattern 

!

pattern: aString

! !

!FuzzyMatcher methodsFor:'comparing'!

match: aString ifScored: aBlock

!

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

! !

!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 

!

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

! !