Rebol3 Code Examplex


Anagrams/Deranged anagrams

Find anagrams where no letter stays in place.

Rebol [
    title: "Rosetta code: Anagrams/Deranged anagrams"
    file:  %Anagrams-Deranged_anagrams.r3
    url:   https://rosettacode.org/wiki/Anagrams-Deranged_anagrams
]
;; Find the longest deranged anagram pair from unixdict.txt
;; A deranged anagram: same multiset of letters, and no position has the same letter in both words.

;; Load or fetch the dictionary
unless exists? %unixdict.txt [
    write %unixdict.txt
    read https://raw.githubusercontent.com/thundergnat/rc-run/refs/heads/master/rc/resources/unixdict.txt
]

words: read/lines %unixdict.txt

;; Build anagram buckets keyed by sorted letters
buckets: make map! [] 25000
foreach w words [
    k: sort copy w
    either find buckets k [
        append buckets/:k w
    ][  put buckets k reduce [w] ]
]

;; Predicate: true if a and b are deranged (same length, no same letter at same index)
deranged?: func [a [string!] b [string!]] [
    repeat i length? a [
        if a/:i == b/:i [return false]
    ]
    true
]

best-a: best-b: none
best-len: 0

;; Search each bucket for deranged pairs, track the longest length
foreach [k vals] buckets [
    if 2 <= length? vals [
        ;; process only near-best lengths
        if best-len <= len: length? vals/1 [
            repeat i length? vals [
                a: vals/:i
                repeat j i - 1 [
                    b: vals/:j
                    if deranged? a b [
                        if best-len < len [
                            best-len: len
                            best-a: a
                            best-b: b
                        ]
                    ]
                ]
            ]
        ]
    ]
]

either all [best-a best-b][
    print rejoin ["Longest deranged anagram length: " best-len]
    print rejoin ["Pair: " best-a "  <->  " best-b]
][
    print "No deranged anagram pair found."
]