Anagram solving by Regex or SQL

Daestrum said:

Following on from the @LucaMs example, by adding a word length column, you can use a where clause to ignore words of the wrong length. Also index the Length and Sorted Letters column to get a faster response.

Click to expand...

LucaMs said:

B4X:

Private Sub SortLetters(Letters As String) As String
    Dim Result As String

    Dim lstLetters As List
    lstLetters.initialise
   
    Dim bytChars() As Byte = Letters.GetBytes("UTF8")
    For i = 0 To bytChars.Length - 1
        lstLetters.Add(bytChars(i))
    Next
    lstLetters.Sort(True)
   
    For i = 0 To lstLetters.Size - 1
        Result = Result & Chr(lstLetters.Get(i))
    Next

    Return result
End Sub

Click to expand...

Daestrum said:

I just tried it without using a database (using a list) and some logic to check the letters - got this result

Click to expand...

LordZenzo said:

did you use my lib?

Click to expand...

Sub Process_Globals
    Dim wordlist As List
End Sub

Sub AppStart (Args() As String)
    Dim st1 As Long = DateTime.now
    wordlist.Initialize
    Dim textRdr As TextReader
    textRdr.Initialize(File.OpenInput("d:/wordlist","words_alpha.txt"))
    Dim wrd As String = textRdr.ReadLine
    
    Do While wrd <> Null
        wordlist.Add(wrd)
        wrd = textRdr.readline
    Loop
    textRdr.Close
    Log("loaded " & wordlist.size & " words in " & (DateTime.Now - st1) & " ms")

    wordlist.Sort(True)
    Dim st As Long = DateTime.now
    Dim srchword As String = "muinimula"
    Log("Search letters [" & srchword & "]")
    Dim flag As Boolean = True
    Dim savedword As String
    For Each word As String In wordlist
        savedword = word
        flag = True
        For a = 0 To srchword.Length - 1
            If srchword.Length <> word.Length Then
                flag = False
                Exit
            End If
            If word.indexof(srchword.CharAt(a)) > -1 Then
                If word.IndexOf(srchword.CharAt(a))=0 Then
                    word = "*" & word.SubString(word.IndexOf(srchword.CharAt(a))+1)
                Else
                    word = word.SubString2(0,word.IndexOf(srchword.CharAt(a))) & "*" & word.SubString(word.IndexOf(srchword.CharAt(a))+1)
                End If
            Else
                flag = False
                Exit
            End If
        Next
        If flag=True And word.Replace("*","")="" Then Log(savedword)
    Next
    Log((DateTime.Now - st) & " ms")
End Sub

Daestrum said:

no it was just some code I knocked up using a list and some code to determine if the letters were contained in the word from the list.

B4X:

Sub Process_Globals
    Dim wordlist As List
End Sub

Sub AppStart (Args() As String)
    Dim st1 As Long = DateTime.now
    wordlist.Initialize
    Dim textRdr As TextReader
    textRdr.Initialize(File.OpenInput("d:/wordlist","words_alpha.txt"))
    Dim wrd As String = textRdr.ReadLine
 
    Do While wrd <> Null
        wordlist.Add(wrd)
        wrd = textRdr.readline
    Loop
    textRdr.Close
    Log("loaded " & wordlist.size & " words in " & (DateTime.Now - st1) & " ms")

    wordlist.Sort(True)
    Dim st As Long = DateTime.now
    Dim srchword As String = "muinimula"
    Log("Search letters [" & srchword & "]")
    Dim flag As Boolean = True
    Dim savedword As String
    For Each word As String In wordlist
        savedword = word
        flag = True
        For a = 0 To srchword.Length - 1
            If srchword.Length <> word.Length Then
                flag = False
                Exit
            End If
            If word.indexof(srchword.CharAt(a)) > -1 Then
                If word.IndexOf(srchword.CharAt(a))=0 Then
                    word = "*" & word.SubString(word.IndexOf(srchword.CharAt(a))+1)
                Else
                    word = word.SubString2(0,word.IndexOf(srchword.CharAt(a))) & "*" & word.SubString(word.IndexOf(srchword.CharAt(a))+1)
                End If
            Else
                flag = False
                Exit
            End If
        Next
        If flag=True And word.Replace("*","")="" Then Log(savedword)
    Next
    Log((DateTime.Now - st) & " ms")
End Sub

Click to expand...

If Letters.Length <> Word.Length Then

Word.indexof(Letters.CharAt(A))

Sub Anagrams(Letters As String) As List
    Dim lstAnagrams As List
    lstAnagrams.Initialize
 
    Letters = Letters.ToLowerCase
 
    Dim Flag As Boolean = True
    Dim SavedWord As String
    Dim IndexOfLetter As Int

    For Each Word As String In mlstWords
        If Word.Length = Letters.Length Then
            SavedWord = Word
            Flag = True
            For A = 0 To Letters.Length - 1
                IndexOfLetter = Word.indexof(Letters.CharAt(A))
                If IndexOfLetter > - 1 Then
                    If IndexOfLetter = 0 Then
                        Word = "*" & Word.SubString(IndexOfLetter + 1)
                    Else
                        Word = Word.SubString2(0, IndexOfLetter) & "*" & Word.SubString(IndexOfLetter + 1)
                    End If
                Else
                    Flag = False
                    Exit
                End If
            Next
            If Flag And Word.Replace("*", "") = "" Then
                lstAnagrams.Add(SavedWord)
            End If
        End If
    Next
    Return lstAnagrams
End Sub

Sub Process_Globals
    Private mlstWords As List
End Sub

Public Sub Init
    mlstWords.Initialize
    Dim textRdr As TextReader
    Dim Dir, FileName As String
    Dir = File.DirAssets
    FileName = "YourWordsTextFile.txt"
    textRdr.Initialize(File.OpenInput(Dir, FileName))
    Dim wrd As String = textRdr.ReadLine

    Do While wrd <> Null
        mlstWords.Add(wrd)
        wrd = textRdr.readline
    Loop
    textRdr.Close
    mlstWords.Sort(True)
End Sub

LucaMs said:

(I typed very slowly on purpose, just to show what is found after each added letter. In the final part I quickly typed "Mario". In short, it finds the anagrams, 8, in a few milliseconds)

Click to expand...

dlfallen said:

This interest in anagrams is curious. I posted a program to solve anagrams (using the 2-list method) nearly 14 years ago and received no response (other than Erel thanking me for sharing).
Share my Creations: Anagram

Click to expand...