Side "Fack"

[bplus]

A little side track from BSpinoza's great Expresso thread:
https://staging.qb64phoenix.com/showthre...2#pid17352

Because I have little control over what my brain or heart finds interesting I became curious how many words can be made by replacing tr in a word with an f, just no accounting for what we humans will get into!

I was thinking about writing a little poem, haiku.... something with clever substitutions of tr with f.

So wouldn't it be helpful to have a double list of real words you can substitute tr with f.

I had a Collins_Word_List.RA file already used for checking for real words in Boggle or other Word Play apps so lets make a list of real words made by replacing tr's with f's

Code: (Select All)

'2023-06-29 took over an hour to get debugged

Dim tr$(1 To 100000), f$(1 To 100000)
Dim As Long trI, fI, i
Dim buf$, wd$
Dim Shared rec15 As String * 15
Dim Shared NTopWord As Long
Dim Shared n$
nl$ = Chr$(13) + Chr$(10) ' eh too much work here for little joke
Open "Collins_Word_List.RA" For Random As #1 Len = 15
NTopWord = LOF(1) / 15
For i = 1 To NTopWord
    Get #1, i, rec15
    wd$ = _Trim$(rec15)
    If InStr(wd$, "TR") Then trI = trI + 1: tr$(trI) = wd$
Next

Open "tr to f.txt" For Output As #2
For i = 1 To trI
    wd$ = strReplace$(tr$(i), "TR", "F")
    If Find&(wd$) Then
        Print tr$(i), wd$
        Print #2, tr$(i), wd$
    End If
Next
Close

Function Find& (x$) ' if I am using this only to find words in dictionary, I can mod to optimize
    ' the RA file is opened and ready for gets
    Dim As Long low, hi, test
    Dim w$
    If Len(x$) < 2 Then Exit Function ' words need to be 3 letters
    low = 1: hi = NTopWord
    While low <= hi
        test = Int((low + hi) / 2)
        Get #1, test, rec15
        w$ = _Trim$(rec15)
        If w$ = x$ Then
            Find& = test: Exit Function
        Else
            If w$ < x$ Then low = test + 1 Else hi = test - 1
        End If
    Wend
End Function

Function strReplace$ (s$, replace$, new$) 'case sensitive  2020-07-28 version
    Dim p As Long, sCopy$, LR As Long, lNew As Long
    If Len(s$) = 0 Or Len(replace$) = 0 Then
        strReplace$ = s$: Exit Function
    Else
        LR = Len(replace$): lNew = Len(new$)
    End If

    sCopy$ = s$ ' otherwise s$ would get changed
    p = InStr(sCopy$, replace$)
    While p
        sCopy$ = Mid$(sCopy$, 1, p - 1) + new$ + Mid$(sCopy$, p + LR)
        p = InStr(p + lNew, sCopy$, replace$)
    Wend
    strReplace$ = sCopy$
End Function

Output in zip and RA (Random Access Dictionary). The RA file requires a String * 15 long record variable to do word lookups without having to load the whole file into an array.

I wonder if @TDarcos or anyone (I offer rep points!) would care to finish this thread with some cute conversion of tr words to f words

see "tr to f.txt" file in zip

Update: Download zip extracted and checked for proper "tr to f.txt" file, yep! OK 253 words but you either know the tr word or the f word but only rarely know both! So it will take a mind wackier than mine (maybe) to compose a cute little saying.

Hey! what a great way to kick off the Summer of Fun with a new banner and a little challenge!