"{ Encoding: utf8 }"

"

 COPYRIGHT (c) 1994 by Claus Gittinger

 COPYRIGHT (c) 2009 by eXept Software AG

              All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

"{ Package: 'stx:libbasic2' }"

"{ NameSpace: Smalltalk }"

Object subclass:#StringUtilities

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	category:'Collections-Text-Support'

!

!StringUtilities class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1994 by Claus Gittinger

 COPYRIGHT (c) 2009 by eXept Software AG

              All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

documentation

"

    some less often used algorithms have been moved to here to

    make libbasic more compact.

"

! !

!StringUtilities class methodsFor:'edit distance'!

editDistanceFrom:s1 to:s2 s:substWeight k:kbdTypoWeight c:caseWeight e:exchangeWeight i:insrtWeight

    "another, simpler editing distance between two strings. 

     See also: levenshtein"

    |editedS2 min d|

    s2 size > s1 size ifTrue:[

        ^ self editDistanceFrom:s2 to:s1 s:substWeight k:kbdTypoWeight c:caseWeight e:exchangeWeight i:insrtWeight

    ].

    s1 size > s2 size ifTrue:[

        0 to:s2 size do:[:pos |

            editedS2 := s2 copyWith:$# insertedAfterIndex:pos.

            d := self editDistanceFrom:s1 to:editedS2 s:substWeight k:kbdTypoWeight c:caseWeight e:exchangeWeight i:insrtWeight.

            min := (min ? d) min:d.

        ].

        ^ min + insrtWeight

    ].

    ^ (1 to:s1 size) sum:

        [:i | 

            ((s2 at:i) == $# or:[ (s1 at:i)=(s2 at:i)]) 

                ifTrue:[0] 

                ifFalse:[substWeight]

        ] 

    "

     'comptuer' levenshteinTo:'computer'      

     self editDistanceFrom:'comptuer' to:'computer' s:4 k:2 c:1 e:nil i:2        

     'computr' levenshteinTo:'computer'                                    

     self editDistanceFrom:'computr' to:'computer' s:4 k:2 c:1 e:nil i:2        

    "

    "Modified (format): / 09-08-2012 / 05:41:59 / cg"

!

isKey:k1 nextTo:k2

    "return true, if k1 and k2 are adjacent keys on the keyboard.

     This is used to specially priorize plausible typing errors of adjacent keys."

    ^ self isKey:k1 nextTo:k2 onKeyboard:(self keyboardLayout)

    "

     self isKey:$a nextTo:$a   

     self isKey:$a nextTo:$s   

     self isKey:$a nextTo:$q   

     self isKey:$a nextTo:$w    

     self isKey:$a nextTo:$y    

     self isKey:$a nextTo:$z    

     self isKey:$a nextTo:$x    

    "

!

isKey:k1 nextTo:k2 onKeyboard:keys

    "return true, if k1 and k2 are adjacent keys on the keyboard defined by keys"

    |row1 row2 col1 col2|

    row1 := keys findFirst:[:eachRow | col1 := eachRow indexOf:k1. col1 ~~ 0].

    row1 == 0 ifTrue:[^ false].

    row2 := keys findFirst:[:eachRow | col2 := eachRow indexOf:k2. col2 ~~ 0].

    row2 == 0 ifTrue:[^ false].

    ^ (row1-row2) abs <= 1 and:[(col1-col2) abs <= 1]

    "

     self isKey:$a nextTo:$q onKeyboard:(StringUtilities keyboardLayoutForLanguage:#de)

     self isKey:$a nextTo:$x onKeyboard:(StringUtilities keyboardLayoutForLanguage:#de)

    "

!

keyboardLayout

    "the keyboard layout (used with algorithms to find possible typing errors,

     for example: edit distance in levenshtein)"

    ^ self keyboardLayoutForLanguage:(UserPreferences current language)

    "

     self keyboardLayout

    "

!

keyboardLayoutForLanguage:lang

    "the keyboard layout (used with algorithms to find possible typing errors,

     for example: edit distance in levenshtein).

     CAVEAT: hard coded us- and german keyboards here - should go into resource file."

    "/ danish

    lang == #da ifTrue:[

        ^ #( 

               '1234567890-'

               '*qwertyuiopå'

               '**asdfghjklæø'

               '***zxcvbnm' ).

    ].

    lang == #no ifTrue:[

        ^ #( 

               '1234567890-'

               '*qwertyuiopå'

               '**asdfghjkløæ'

               '***zxcvbnm' ).

    ].

    (lang == #de or:[lang == #pl or:[lang == #cz]]) ifTrue:[

        ^ #( 

               '1234567890-'

               '*qwertzuiop'

               '**asdfghjkl:'

               '***yxcvbnm' ).

    ].

    lang == #hu ifTrue:[

        ^ #( 

               '1234567890-'                         

               '*qwertyuiopõú'

               '**asdfghjkléáũ'

               '**ízxcvbnm' ).

    ].

    lang == #pt ifTrue:[

        ^ #( 

               '1234567890-'

               '*qwertyuiop'

               '**asdfghjklç'

               '***zxcvbnm' ).

    ].

    lang == #es ifTrue:[

        ^ #( 

               '1234567890-'

               '*qwertyuiop'

               '**asdfghjklñ'

               '***zxcvbnm' ).

    ].

    (lang == #sv or:[lang == #fi]) ifTrue:[

        ^ #( 

               '1234567890-'

               '*qwertyuiopå'

               '**asdfghjklöä'

               '***zxcvbnm' ).

    ].

    lang == #fr ifTrue:[

        ^ #( 

               '1234567890'

               '*azertyuiop'

               '**qsdfghjklm'

               '***wxcvbn,' ).

    ].

    "/ fallback: english, dutch, italian

    ^ #( 

           '1234567890-'

           '*qwertyuiop'

           '**asdfghjkl:'

           '***zxcvbnm' ).

    "

     self keyboardLayoutForLanguage:#de 

    "

    "Modified (comment): / 09-08-2012 / 05:39:19 / cg"

!

levenshteinDistanceFrom:string1 to:string2 s:substWeight k:kbdTypoWeight c:caseWeight e:exchangeWeight i:insrtWeight d:deleteWeight

    "parametrized levenshtein.

     return the levenshtein distance of two strings;

     this value corrensponds to the number of replacements that have to be

     made to get string2 from string1. The smaller the returned number,

     tbe more similar are the two strings.

     The arguments are the costs for

        s:substitution,

        k:keyboard type (substitution),   if nil, s is used

        c:case-change,                    if nil, s is used

        i:insertion

        d:deletion

        e:exchange                        if nil, s*2 is used

     of a character.

     See IEEE transactions on Computers 1976 Pg 172 ff."

    |d  "delta matrix"

     len1 "{ Class: SmallInteger }"

     len2 "{ Class: SmallInteger }"

     dim  "{ Class: SmallInteger }"

     prevRow row col

     dimPlus1 "{ Class: SmallInteger }"

     min pp c1 c2|

    len1 := string1 size.

    len2 := string2 size.

    "create the help-matrix"

    dim := len1 max:len2.

    dimPlus1 := dim + 1.

    d := Array new:dimPlus1.

    1 to:dimPlus1 do:[:i |

        d at:i put:(Array new:dimPlus1)

    ].

    "init help-matrix"

    (d at:1) at:1 put:0.

    row := d at:1.

    1 to:dim do:[:j |

        row at:(j + 1) put:( (row at:j) + insrtWeight )

    ].

    1 to:dim do:[:i |

        (d at:(i + 1)) at:1 put:(  ((d at:i) at:1) + deleteWeight )

    ].

    1 to:len1 do:[:i |

        c1 := string1 at:i.

        1 to:len2 do:[:j |

            c2 := string2 at:j.

            (c1 == c2) ifTrue:[

                pp := 0

            ] ifFalse:[

                (c1 asLowercase == c2 asLowercase) ifTrue:[

                    pp := caseWeight

                ] ifFalse:[

                    pp := substWeight.

                    substWeight ~~ kbdTypoWeight ifTrue:[

                        (self isKey:c1 asLowercase nextTo:c2 asLowercase) ifTrue:[

                            pp := kbdTypoWeight ? substWeight.

                        ].

                    ].

                    "/ assmuing (;-) that an exchange is very common when typing...

                    exchangeWeight notNil ifTrue:[

                        (i < len1 and:[j < len2]) ifTrue:[

                            ((string1 at:i) = (string2 at:(j+1))

                            and:[ (string1 at:i+1) = (string2 at:j) ]) ifTrue:[

                                pp := exchangeWeight.

                            ].

                        ].

                        (i > 1 and:[j > 1]) ifTrue:[

                            ((string1 at:i) = (string2 at:(j-1))

                            and:[ (string1 at:i-1) = (string2 at:j) ]) ifTrue:[

                                pp := exchangeWeight.

                            ].

                        ].

                    ].

                ]

            ].

            prevRow := d at:i.

            row := d at:(i + 1).

            col := j + 1.

            min := (prevRow at:j) + pp.

            min := min min:( (row at:j) + insrtWeight).

            min := min min:( (prevRow at:col) + deleteWeight).

            row at:col put: min

        ]

    ].

    ^ (d at:(len1 + 1)) at:(len2 + 1)

    "

     'comptuer' levenshteinTo:'computer'       

     self levenshteinDistanceFrom:'comptuer' to:'computer' 

            s:4 k:2 c:1 e:nil i:2 d:6    

    "

    "Modified (comment): / 09-08-2012 / 05:40:08 / cg"

! !

!StringUtilities class methodsFor:'matching'!

stringMatchFunctionFor:aMultiPattern glob:searchForGlobPattern regex:searchForRegexPattern caseSensitive:searchIsCaseSensitive

    "generates a check function which - given a string - checks for a match.

     The match-pattern argument aMultiPattern

     may contain multiple patterns, 

     separated by ';' (for and-search) or '|' (for or-search).

     If the pattern is invalid, nil is returned and an information-notification

     is signalled"

    |combinator stringToSearchFor stringsToSearchFor checkFunction|

    stringToSearchFor := aMultiPattern.

    combinator := #conform:.

    (stringToSearchFor includes:$|) ifTrue:[

        stringsToSearchFor := stringToSearchFor asCollectionOfSubstringsSeparatedBy:$|.

        combinator := #contains:.

    ] ifFalse:[

        (stringToSearchFor includes:$;) ifTrue:[

            stringsToSearchFor := stringToSearchFor asCollectionOfSubstringsSeparatedBy:$;.

        ] ifFalse:[

            stringsToSearchFor := nil.

"/            lastStringToSearchFor := self stringOfCurrentSearchList.

"/            (lastStringToSearchFor notEmptyOrNil and:[stringToSearchFor startsWith:lastStringToSearchFor]) ifTrue:[

"/                searchRoot := AbstractBrowserItemPO new.

"/                self searchResultList do:[:each | searchRoot add:each treePO].

"/                self stringOfCurrentSearchList:stringToSearchFor.

"/                Transcript showCR:'fast'.

"/            ].

"/            self stringOfCurrentSearchList:stringToSearchFor.

        ]

    ].

    Error handle:[:ex |

        self notify:('Invalid pattern: ',ex description).

        ^ nil

    ] do:[

        |lcString shortString regexPattern regexPatterns|

        stringsToSearchFor isNil ifTrue:[

            "/ single string search

            (searchForGlobPattern and:[stringToSearchFor includesMatchCharacters]) ifTrue:[

                |matchScanArray|

                "/ verify if this is a valid pattern; if not, do not search

                matchScanArray := String matchScanArrayFrom:stringToSearchFor escapeCharacter:String matchEscapeCharacter.

                matchScanArray isNil ifTrue:[

                    self information:'Invalid search pattern'.

                    ^ nil.

                ].

                ((stringToSearchFor startsWith:$*) and:[(stringToSearchFor copyFrom:2) includesMatchCharacters not]) ifTrue:[

                    shortString := (stringToSearchFor copyFrom:2).

                    searchIsCaseSensitive ifTrue:[

                        checkFunction := [:s | s endsWith:shortString].

                    ] ifFalse:[

                        lcString := shortString asLowercase.

                        checkFunction := [:s | s asLowercase endsWith:lcString].

                    ]

                ] ifFalse:[

                    ((stringToSearchFor endsWith:$*) and:[(stringToSearchFor copyButLast:1) includesMatchCharacters not]) ifTrue:[

                        shortString := (stringToSearchFor copyButLast:1).

                        searchIsCaseSensitive ifTrue:[

                            checkFunction := [:s | s startsWith:shortString].

                        ] ifFalse:[

                            lcString := shortString asLowercase.

                            checkFunction := [:s | s asLowercase startsWith:lcString].

                        ]

                    ] ifFalse:[

                        regexPattern := searchIsCaseSensitive 

                                                ifTrue:[stringToSearchFor asRegex] 

                                                ifFalse:[stringToSearchFor asRegexIgnoringCase].

                        checkFunction := [:s | regexPattern hasMatchesIn:s].

                    ].

                ].

            ] ifFalse:[

                searchForRegexPattern ifTrue:[

                    regexPattern := searchIsCaseSensitive 

                                        ifTrue:[stringToSearchFor asRegex] 

                                        ifFalse:[stringToSearchFor asRegexIgnoringCase].

                    checkFunction := [:s | regexPattern hasMatchesIn:s].

                ] ifFalse:[

                    checkFunction :=

                        [:s | s includesString:stringToSearchFor caseSensitive:searchIsCaseSensitive]

                ]

            ].

        ] ifFalse:[

            "/ multi string search

            searchForGlobPattern ifTrue:[

                stringsToSearchFor do:[:eachStringToSearchFor |

                    |matchScanArray|

                    "/ verify if this is a valid pattern; if not, do not search

                    matchScanArray := String matchScanArrayFrom:eachStringToSearchFor escapeCharacter:String matchEscapeCharacter.

                    matchScanArray isNil ifTrue:[

                        self information:'Invalid search pattern'.

                        ^ nil.

                    ].

                ].

                checkFunction :=

                    [:s |

                        stringsToSearchFor perform:combinator with:[:eachStringToSearchFor |

                            s includesMatchString:eachStringToSearchFor caseSensitive:searchIsCaseSensitive

                        ]

                    ].

            ] ifFalse:[

                searchForRegexPattern ifTrue:[

                    regexPatterns := stringsToSearchFor collect:[:eachPatternString|

                                            searchIsCaseSensitive 

                                                ifTrue:[eachPatternString asRegex] 

                                                ifFalse:[eachPatternString asRegexIgnoringCase].

                                        ].

                    checkFunction := [:s | regexPattern hasMatchesIn:s].

                    checkFunction :=

                        [:s |

                            regexPatterns perform:combinator with:[:eachRegexPattern |

                                eachRegexPattern hasMatchesIn:s

                            ]

                        ].

                ] ifFalse:[

                    checkFunction :=

                        [:s |

                            stringsToSearchFor perform:combinator with:[:eachStringToSearchFor |

                                s includesString:eachStringToSearchFor caseSensitive:searchIsCaseSensitive

                            ]

                        ]

                ]

            ].

        ].

    ].

    ^ checkFunction

    "

     |fn|

     fn := self stringMatchFunctionFor:'aaa|bbb' glob:false regex:false caseSensitive:false.

     fn value:'   aaa   '.

     fn value:'   aa   '.

     fn value:'   bbb   '.

     fn value:'  aa bb   '.

    "

    "

     |fn|

     fn := self stringMatchFunctionFor:'aaa;bbb' glob:false regex:false caseSensitive:false.

     fn value:'   aaa   '.

     fn value:'   aa   '.

     fn value:'   bbb   '.

     fn value:'  aa bb   '.

     fn value:'  aaa bb   '.

     fn value:'  aaa bbb   '.

    "

    "

     |fn|

     fn := self stringMatchFunctionFor:'aa*;bb*' glob:true regex:false caseSensitive:false.

     fn value:'   aaa   '.

     fn value:'   aa   '.

     fn value:'   bbb   '.

     fn value:'  aa bb   '.

     fn value:'  aaa bb   '.

     fn value:'  aaa bbb   '.

    "

    "Created: / 02-05-2019 / 17:32:12 / Claus Gittinger"

    "Modified: / 30-05-2019 / 11:26:26 / Claus Gittinger"

! !

!StringUtilities class methodsFor:'queries'!

isUtilityClass

    ^ self == StringUtilities

! !

!StringUtilities class methodsFor:'documentation'!

version

    ^ '$Header$'

!

version_CVS

    ^ '$Header$'

! !