Task: Anagrams_Deranged anagrams







Python: import urllib.request
from collections import defaultdict
from itertools import combinations

def getwords(url='http://www.puzzlers.org/pub/wordlists/unixdict.txt'):
    return list(set(urllib.request.urlopen(url).read().decode().split()))

def find_anagrams(words):
    anagram = defaultdict(list) 
    for word in words:
        anagram[tuple(sorted(word))].append( word )
    return dict((key, words) for key, words in anagram.items()
                if len(words) > 1)

def is_deranged(words):
    'returns pairs of words that have no character in the same position'
    return [ (word1, word2)
             for word1,word2 in combinations(words, 2)
             if all(ch1 != ch2 for ch1, ch2 in zip(word1, word2)) ]

def largest_deranged_ana(anagrams):
    ordered_anagrams = sorted(anagrams.items(),
                              key=lambda x:(-len(x[0]), x[0]))
    for _, words in ordered_anagrams:
        deranged_pairs = is_deranged(words)
        if deranged_pairs:
            return deranged_pairs
    return []

if __name__ == '__main__':
    words = getwords('http://www.puzzlers.org/pub/wordlists/unixdict.txt')
    print("Word count:", len(words))

    anagrams = find_anagrams(words)
    print("Anagram count:", len(anagrams),"\n")

    print("Longest anagrams with no characters in the same position:")
    print('  ' + '\n  '.join(', '.join(pairs)
                             for pairs in largest_deranged_ana(anagrams)))


VB: Sub Main_DerangedAnagrams()
Dim ListeWords() As String, Book As String, i As Long, j As Long, tempLen As Integer, MaxLen As Integer, tempStr As String, IsDeranged As Boolean, count As Integer, bAnag As Boolean
Dim t As Single
t = Timer
    Book = Read_File("C:\Users\" & Environ("Username") & "\Desktop\unixdict.txt")
    ListeWords = Split(Book, vbNewLine)
    For i = LBound(ListeWords) To UBound(ListeWords) - 1
        For j = i + 1 To UBound(ListeWords)
            If Len(ListeWords(i)) = Len(ListeWords(j)) Then
                tempLen = 0
                IsDeranged = False
                bAnag = IsAnagram(ListeWords(i), ListeWords(j), IsDeranged, tempLen)
                If IsDeranged Then
                    count = count + 1
                    If tempLen > MaxLen Then
                        MaxLen = tempLen
                        tempStr = ListeWords(i) & ", " & ListeWords(j)
                    End If
                End If
            End If
        Next j
    Next i
    Debug.Print "There is : " & count & " deranged anagram, in unixdict.txt."
    Debug.Print "The longest is : " & tempStr
    Debug.Print "Lenght  : " & MaxLen
    Debug.Print "Time to compute : " & Timer - t & " sec."
End Sub
Private Function Read_File(Fic As String) As String
Dim Nb As Integer
    Nb = FreeFile
    Open Fic For Input As #Nb
        Read_File = Input(LOF(Nb), #Nb)
    Close #Nb
End Function
Function IsAnagram(str1 As String, str2 As String, DerangedAnagram As Boolean, Lenght As Integer) As Boolean
Dim i As Integer
    str1 = Trim(UCase(str1))
    str2 = Trim(UCase(str2))
    For i = 1 To Len(str1)
        If Len(Replace(str1, Mid$(str1, i, 1), vbNullString)) <> Len(Replace(str2, Mid$(str1, i, 1), vbNullString)) Then
            Exit Function
        End If
        If Mid$(str1, i, 1) = Mid$(str2, i, 1) Then
            Exit Function
        End If
    Next i
    IsAnagram = True
    DerangedAnagram = True
    Lenght = Len(str1)
End Function