QB64 Phoenix Edition
Emordnilap's - Printable Version

+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Programs (https://qb64phoenix.com/forum/forumdisplay.php?fid=7)
+---- Thread: Emordnilap's (/showthread.php?tid=3255)



Emordnilap's - bplus - 12-08-2024

Code: (Select All)
Option _Explicit
_Title "emordnilap's found" ' b+ 2024-12-07

' I saw this   https://www.youtube.com/shorts/65_8t1OEZSc  and was inspired!

' an emordnilap is palindrome spelled backwards
' If a word spelled backwards is also a word the 2 words are an emordnilap pair.

' try the unixdict.txt file

Dim As Long index, fl, p, np, i, j, wCnt, test, emors
Dim buf$, wd$, b$
ReDim words$(1 To 1), emord$(1 To 1)
Open "unixdict.txt" For Binary As #1
' http://www.puzzlers.org/pub/wordlists/unixdict.txt
fl = LOF(1): buf$ = Space$(fl)
Get #1, , buf$
Close #1
p = 1: index = 0
While p < fl
    np = InStr(p, buf$, Chr$(10))
    If np Then
        wd$ = Mid$(buf$, p, np - p): Print wd$
        If Len(wd$) > 1 Then StrAppend words$(), wd$: wCnt = wCnt + 1
        p = np + 1
    Else
        p = fl
    End If
Wend
For i = 1 To wCnt
    wd$ = words$(i)
    b$ = "": j = 1
    While j <= Len(wd$)
        b$ = Mid$(wd$, j, 1) + b$
        j = j + 1
    Wend
    If b$ <> wd$ Then ' NOT Palindrome! So lookup to see if word in words()
        test = Find&(words$(), b$)
        If test Then
            If Len(wd$) > 3 Then
                StrAppend emord$(), wd$: emors = emors + 1
                Print emors, wd$, b$
                'If emors Mod 20 = 19 Then Sleep: Cls
            End If
        End If
    End If
Next
Sleep

_Title "Emordnilap Machine"
Screen _NewImage(700, 700, 32)
_ScreenMove 340, 20
Randomize Timer
Dim As Long r
Do
    r = Int(Rnd * emors) + 1
    EmordnilapMachine emord$(r)
    _Delay .2
Loop Until _KeyDown(27)

Sub EmordnilapMachine (eword$)
    Dim As Long cx, cy, wl, th, tw, xoff, l
    Dim As Double a, mid, r
    cx = _Width / 2: cy = _Height / 2: wl = Len(eword$): th = 64
    mid = wl / 2
    For a = 0 To 2 * _Pi - .001 Step _Pi(2 / 360)
        Cls
        For l = 1 To wl
            r = th * ((l - .5) - mid)
            Text cx + r * Cos(a) - 16, cy + r * Sin(a) - 16, th, &HFFFFFFFF, Mid$(eword$, l, 1)
        Next
        If Abs(a - _Pi) < .001 Or Abs(a - 2 * _Pi - .001) < .001 Then _Delay .2
        _Display
        _Limit 30
    Next
End Sub

Function Find& (SortedArr$(), x$)
    Dim As Long low, hi, test
    low = LBound(SortedArr$): hi = UBound(SortedArr$)
    While low <= hi
        test = Int((low + hi) / 2)
        If SortedArr$(test) = x$ Then
            Find& = test: Exit Function
        Else
            If SortedArr$(test) < x$ Then low = test + 1 Else hi = test - 1
        End If
    Wend
End Function

Sub StrAppend (arr() As String, addItem$) ' update 2024-12-06 to test for empty first slot
    If arr(LBound(arr)) = "" Then
        arr(LBound(arr)) = addItem$
    Else
        ReDim _Preserve arr(LBound(arr) To UBound(arr) + 1) As String
        arr(UBound(arr)) = addItem$
    End If
End Sub

Sub Text (x, y, textHeight, K As _Unsigned Long, txt$)
    Dim fg As _Unsigned Long, bg As _Unsigned Long, cur&, i&
    fg = _DefaultColor: bg = _BackgroundColor: cur& = _Dest
    i& = _NewImage(8 * Len(txt$), 16, 32)
    _Dest i&: Color K, _RGBA32(0, 0, 0, 0): _PrintString (0, 0), txt$
    _PutImage (x, y)-Step(Len(txt$) * textHeight / 2, textHeight), i&, cur&
    Color fg, bg: _FreeImage i&: _Dest cur&
End Sub

Seems like there are way more Palindromes than Emordnilaps.

zip has source and unixdict.txt file for a word list to check.


RE: Emordnilap's - PhilOfPerth - 12-08-2024

(12-08-2024, 02:09 AM)bplus Wrote:
Code: (Select All)
Option _Explicit
_Title "emordnilap's found" ' b+ 2024-12-07

' I saw this   https://www.youtube.com/shorts/65_8t1OEZSc  and was inspired!

' an emordnilap is palindrome spelled backwards
' If a word spelled backwards is also a word the 2 words are an emordnilap pair.

' try the unixdict.txt file

Dim As Long index, fl, p, np, i, j, wCnt, test, emors
Dim buf$, wd$, b$
ReDim words$(1 To 1), emord$(1 To 1)
Open "unixdict.txt" For Binary As #1
' http://www.puzzlers.org/pub/wordlists/unixdict.txt
fl = LOF(1): buf$ = Space$(fl)
Get #1, , buf$
Close #1
p = 1: index = 0
While p < fl
    np = InStr(p, buf$, Chr$(10))
    If np Then
        wd$ = Mid$(buf$, p, np - p): Print wd$
        If Len(wd$) > 1 Then StrAppend words$(), wd$: wCnt = wCnt + 1
        p = np + 1
    Else
        p = fl
    End If
Wend
For i = 1 To wCnt
    wd$ = words$(i)
    b$ = "": j = 1
    While j <= Len(wd$)
        b$ = Mid$(wd$, j, 1) + b$
        j = j + 1
    Wend
    If b$ <> wd$ Then ' NOT Palindrome! So lookup to see if word in words()
        test = Find&(words$(), b$)
        If test Then
            If Len(wd$) > 3 Then
                StrAppend emord$(), wd$: emors = emors + 1
                Print emors, wd$, b$
                'If emors Mod 20 = 19 Then Sleep: Cls
            End If
        End If
    End If
Next
Sleep

_Title "Emordnilap Machine"
Screen _NewImage(700, 700, 32)
_ScreenMove 340, 20
Randomize Timer
Dim As Long r
Do
    r = Int(Rnd * emors) + 1
    EmordnilapMachine emord$(r)
    _Delay .2
Loop Until _KeyDown(27)

Sub EmordnilapMachine (eword$)
    Dim As Long cx, cy, wl, th, tw, xoff, l
    Dim As Double a, mid, r
    cx = _Width / 2: cy = _Height / 2: wl = Len(eword$): th = 64
    mid = wl / 2
    For a = 0 To 2 * _Pi - .001 Step _Pi(2 / 360)
        Cls
        For l = 1 To wl
            r = th * ((l - .5) - mid)
            Text cx + r * Cos(a) - 16, cy + r * Sin(a) - 16, th, &HFFFFFFFF, Mid$(eword$, l, 1)
        Next
        If Abs(a - _Pi) < .001 Or Abs(a - 2 * _Pi - .001) < .001 Then _Delay .2
        _Display
        _Limit 30
    Next
End Sub

Function Find& (SortedArr$(), x$)
    Dim As Long low, hi, test
    low = LBound(SortedArr$): hi = UBound(SortedArr$)
    While low <= hi
        test = Int((low + hi) / 2)
        If SortedArr$(test) = x$ Then
            Find& = test: Exit Function
        Else
            If SortedArr$(test) < x$ Then low = test + 1 Else hi = test - 1
        End If
    Wend
End Function

Sub StrAppend (arr() As String, addItem$) ' update 2024-12-06 to test for empty first slot
    If arr(LBound(arr)) = "" Then
        arr(LBound(arr)) = addItem$
    Else
        ReDim _Preserve arr(LBound(arr) To UBound(arr) + 1) As String
        arr(UBound(arr)) = addItem$
    End If
End Sub

Sub Text (x, y, textHeight, K As _Unsigned Long, txt$)
    Dim fg As _Unsigned Long, bg As _Unsigned Long, cur&, i&
    fg = _DefaultColor: bg = _BackgroundColor: cur& = _Dest
    i& = _NewImage(8 * Len(txt$), 16, 32)
    _Dest i&: Color K, _RGBA32(0, 0, 0, 0): _PrintString (0, 0), txt$
    _PutImage (x, y)-Step(Len(txt$) * textHeight / 2, textHeight), i&, cur&
    Color fg, bg: _FreeImage i&: _Dest cur&
End Sub

Seems like there are way more Palindromes than Emordnilaps.

zip has source and unixdict.txt file for a word list to check.

Hey, that's my file!  Big Grin

I've written a file called Emordnilaps that searches the dictionary for all words that have a palindrome! I use it to help with a few word-games i've written or am writing!
Not nearly as professional as yours, of course, but it gets the job done.
I'll work through yours and see what I can use to improve mine, if that's ko.


RE: Emordnilap's - JRace - 12-08-2024

Neat.

My long-time favorite emordnilap: boobytrap.


RE: Emordnilap's - PhilOfPerth - 12-08-2024

(12-08-2024, 02:45 AM)JRace Wrote: Neat.

My long-time favorite emordnilap: boobytrap.

Hmm, yeah. They may  end up being similies too!  Rolleyes


RE: Emordnilap's - bplus - 12-08-2024

Yeah as Phil brought up, I kept emord's > 3 letters, there were 316 or 158 pairs from unixdict.txt before I restricted to >3 letters to show on the Machine.

lines 37 and up:
Code: (Select All)
If test Then
            'If Len(wd$) > 3 Then
            StrAppend emord$(), wd$: emors = emors + 1
            Print emors, wd$, b$
            'If emors Mod 20 = 19 Then Sleep: Cls
            'End If
        End If



RE: Emordnilap's - bplus - 12-08-2024

OK 596 pairs found in the Scrabble Word List for 2006.

let's see a longer one in the machine:
   
that's one found in video.

here is (fixed) zip for bigger word file and counting and showing all pairs 3 letters and up:


RE: Emordnilap's - bplus - 12-08-2024

Emordnilap Machine With Gears

Code: (Select All)

Option _Explicit
_Title "emordnilap machine with gears" ' b+ 2024-12-08
' I saw this https://www.youtube.com/shorts/65_8t1OEZSc and was inspired!
' an emordnilap is palindrome spelled backwards
' If a word spelled backwards is also a word the 2 words are an emordnilap pair.

' using Scrabble Word List 2006.txt file for more words

Dim As Long index, fl, p, np, i, j, wCnt, test, emors
Dim buf$, wd$, b$, nl$
ReDim words$(1 To 1), emord$(1 To 1)
nl$ = Chr$(13) + Chr$(10)
Open "Scrabble Word List 2006.txt" For Binary As #1

fl = LOF(1): buf$ = Space$(fl)
Get #1, , buf$
Close #1
p = 1: index = 0
While p < fl
np = InStr(p, buf$, nl$)
If np Then
wd$ = Mid$(buf$, p, np - p): Print wd$
If Len(wd$) > 1 Then StrAppend words$(), wd$: wCnt = wCnt + 1
p = np + 2
Else
p = fl
End If
Wend
Print "words$() loaded..."
For i = 1 To wCnt
wd$ = words$(i)
b$ = "": j = 1
While j <= Len(wd$)
b$ = Mid$(wd$, j, 1) + b$
j = j + 1
Wend
If b$ <> wd$ Then ' NOT Palindrome! So lookup to see if word in words()
test = Find&(words$(), b$)
If test Then
If Len(wd$) > 3 Then
StrAppend emord$(), wd$: emors = emors + 1
Print emors, wd$, b$
'If emors Mod 20 = 19 Then Sleep: Cls
End If
End If
End If
Next
Print " For Scrabble file 596 pairs should have been found."
Print " press any for the Emordnilap Machine to run random display..."
Sleep
_Title "Emordnilap Machine"
Screen _NewImage(700, 700, 32)
_ScreenMove 340, 20
Randomize Timer
Dim As Long r
Do
r = Int(Rnd * emors) + 1
If Len(emord$(r)) >= 5 Then
EmordnilapMachine emord$(r)
_Delay .2
End If
Loop Until _KeyDown(27)

Sub EmordnilapMachine (eword$)
Dim As Long cx, cy, wl, th, l
Dim As Double a, mid, r, gx, gy, nt, sq, gr, a2
nt = 18: sq = 5: gr = gearRadius(nt, sq): a2 = _Pi / nt
cx = _Width / 2: cy = _Height / 2: wl = Len(eword$): th = 64
mid = wl / 2
For a = 0 To 2 * _Pi Step _Pi(2 / 360)
Cls
For l = 1 To wl
r = th * ((l - .5) - mid)
gx = cx + r * Cos(a)
gy = cy + r * Sin(a)
If l Mod 2 = 0 Then
gear gx, gy, nt, sq, 2 * a, &HFF0000FF
Else
gear gx, gy, nt, sq, -a + .5 * a2, &HFFFF0000
End If
Text gx - 15, gy - 28, th, &HFFFFFFFF, Mid$(eword$, l, 1)
Next
If Abs(a - _Pi) < .001 Or Abs(a - 2 * _Pi) < .001 Then _Delay .2
_Display
_Limit 30
Next
End Sub

Function Find& (SortedArr$(), x$)
Dim As Long low, hi, test
low = LBound(SortedArr$): hi = UBound(SortedArr$)
While low <= hi
test = Int((low + hi) / 2)
If SortedArr$(test) = x$ Then
Find& = test: Exit Function
Else
If SortedArr$(test) < x$ Then low = test + 1 Else hi = test - 1
End If
Wend
End Function

Sub StrAppend (arr() As String, addItem$) ' update 2024-12-06 to test for empty first slot
If arr(LBound(arr)) = "" Then
arr(LBound(arr)) = addItem$
Else
ReDim _Preserve arr(LBound(arr) To UBound(arr) + 1) As String
arr(UBound(arr)) = addItem$
End If
End Sub

Sub Text (x, y, textHeight, K As _Unsigned Long, txt$)
Dim fg As _Unsigned Long, bg As _Unsigned Long, cur&, i&
fg = _DefaultColor: bg = _BackgroundColor: cur& = _Dest
i& = _NewImage(8 * Len(txt$), 16, 32)
_Dest i&: Color K, _RGBA32(0, 0, 0, 0): _PrintString (0, 0), txt$
_PutImage (x, y)-Step(Len(txt$) * textHeight / 2, textHeight), i&, cur&
Color fg, bg: _FreeImage i&: _Dest cur&
End Sub

Function gearRadius (nteeth, sqtooth)
gearRadius = .5 * sqtooth / Sin(.5 * _Pi / nteeth)
End Function

Sub gear (x, y, nteeth, sqtooth, raOffset, K As _Unsigned Long)
Dim radius, ra, x2, y2
Dim As _Unsigned Long K1

radius = .5 * sqtooth / Sin(.5 * _Pi / nteeth)
For ra = 0 To 2 * _Pi Step 2 * _Pi / nteeth
x2 = x + (radius + sqtooth) * Cos(ra + raOffset)
y2 = y + (radius + sqtooth) * Sin(ra + raOffset)
thic x, y, x2, y2, sqtooth, K
Next
'to speed things up and reduce blicking just do a circle fill x, y already set and pen color too
For ra = _Pi / nteeth To 2 * _Pi Step 2 * _Pi / nteeth
x2 = x + radius * Cos(ra + raOffset)
y2 = y + radius * Sin(ra + raOffset)
thic x, y, x2, y2, sqtooth, K
Next
Color _RGB32(155, 70, 35)
FC3 x, y, .9 * radius, K
FC3 x, y, .2 * radius, &HFF000000
thic x, y, x + (.2 * radius + sqtooth) * Cos(raOffset), y + (.2 * radius + sqtooth) * Sin(raOffset), sqtooth, &HFF000000
End Sub

Sub thic (x1, y1, x2, y2, thick, K As _Unsigned Long)
Dim t2, a, x3, y3, x4, y4, x5, y5, x6, y6
t2 = thick / 2
If t2 < 1 Then t2 = 1
a = _Atan2(y2 - y1, x2 - x1)
x3 = x1 + t2 * Cos(a + _Pi(.5))
y3 = y1 + t2 * Sin(a + _Pi(.5))
x4 = x1 + t2 * Cos(a - _Pi(.5))
y4 = y1 + t2 * Sin(a - _Pi(.5))
x5 = x2 + t2 * Cos(a + _Pi(.5))
y5 = y2 + t2 * Sin(a + _Pi(.5))
x6 = x2 + t2 * Cos(a - _Pi(.5))
y6 = y2 + t2 * Sin(a - _Pi(.5))
filltri x6, y6, x4, y4, x3, y3, K
filltri x3, y3, x5, y5, x6, y6, K
End Sub

Sub FC3 (cx As Long, cy As Long, r As Long, clr~&) ' no suffix punctuation use the Global Default Type as Long or Single or Double
Dim As Long r2, x, y ' for Option _Explicit
If r < 1 Then Exit Sub
Line (cx - r, cy)-(cx + r, cy), clr~&, BF
r2 = r * r
Do
y = y + 1
x = Sqr(r2 - y * y)
Line (cx - x, cy + y)-(cx + x, cy + y), clr~&, BF
Line (cx - x, cy - y)-(cx + x, cy - y), clr~&, BF
Loop Until y = r
End Sub

' found at QB64.net: http://www.qb64.net/forum/index.php?topic=14425.0
Sub filltri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
Dim a&
a& = _NewImage(1, 1, 32)
_Dest a&
PSet (0, 0), K
_Dest 0
_MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
_FreeImage a& '<<< this is important!
End Sub



   

Zip with Scrabble words:


RE: Emordnilap's - Petr - 12-08-2024

Nicely done, BPlus  Smile


RE: Emordnilap's - bplus - 12-08-2024

Thanks Petr!

I reran the word list for 3 letters and above and got 886 pairs from the Scrabble Word List file.

Here they are!
Code: (Select All)
1            abo           oba
2            abos          soba
3            abut          tuba
4            ado           oda
5            ados          soda
6            agar          raga
7            agas          saga
8            agenes        senega
9            ahs           sha
10           aider         redia
11           air           ria
12           airts         stria
13           ajar          raja
14           alan          nala
15           alif          fila
16           amen          nema
17           amis          sima
18           anger         regna
19           animal        lamina
20           animes        semina
21           anon          nona
22           ante          etna
23           apod          dopa
24           arb           bra
25           are           era
26           ares          sera
27           aril          lira
28           arris         sirra
29           arum          mura
30           ate           eta
31           ates          seta
32           auks          skua
33           avid          diva
34           avo           ova
35           bad           dab
36           bag           gab
37           bal           lab
38           bals          slab
39           ban           nab
40           bard          drab
41           bas           sab
42           bat           tab
43           bats          stab
44           bed           deb
45           beef          feeb
46           ben           neb
47           bid           dib
48           big           gib
49           bin           nib
50           bins          snib
51           bird          drib
52           bis           sib
53           blub          bulb
54           bog           gob
55           bonk          knob
56           bos           sob
57           bots          stob
58           bows          swob
59           boy           yob
60           bra           arb
61           brad          darb
62           brag          garb
63           bro           orb
64           bros          sorb
65           bud           dub
66           bulb          blub
67           bun           nub
68           buns          snub
69           bur           rub
70           burd          drub
71           burg          grub
72           bus           sub
73           but           tub
74           buts          stub
75           cam           mac
76           cap           pac
77           cares         serac
78           cep           pec
79           ceps          spec
80           cis           sic
81           cite          etic
82           cod           doc
83           cor           roc
84           cram          marc
85           dab           bad
86           dag           gad
87           dah           had
88           dahs          shad
89           dal           lad
90           dam           mad
91           dap           pad
92           darb          brad
93           dart          trad
94           daw           wad
95           deb           bed
96           debut         tubed
97           decaf         faced
98           decal         laced
99           dedal         laded
100          deem          meed
101          deep          peed
102          deeps         speed
103          deer          reed
104          dees          seed
105          deet          teed
106          deets         steed
107          def           fed
108          defer         refed
109          deffer        reffed
110          degami        imaged
111          deifier       reified
112          deil          lied
113          deke          eked
114          del           led
115          delf          fled
116          deliver       reviled
117          dels          sled
118          demit         timed
119          denier        reined
120          denies        seined
121          denim         mined
122          dens          sned
123          depot         toped
124          depots        stoped
125          derat         tared
126          derats        stared
127          dessert       tressed
128          desserts      stressed
129          devas         saved
130          devil         lived
131          dew           wed
132          dewans        snawed
133          dexes         sexed
134          dial          laid
135          dialer        relaid
136          diaper        repaid
137          dib           bid
138          dif           fid
139          dig           gid
140          dim           mid
141          dinar         ranid
142          diol          loid
143          diols         sloid
144          diva          avid
145          doc           cod
146          dog           god
147          dom           mod
148          don           nod
149          doom          mood
150          door          rood
151          dopa          apod
152          dor           rod
153          dormin        nimrod
154          dorp          prod
155          dos           sod
156          doser         resod
157          dot           tod
158          drab          bard
159          drail         liard
160          draw          ward
161          drawer        reward
162          draws         sward
163          dray          yard
164          drib          bird
165          drub          burd
166          dual          laud
167          dub           bud
168          duel          leud
169          duo           oud
170          dup           pud
171          dups          spud
172          eat           tae
173          edile         elide
174          edit          tide
175          eel           lee
176          eked          deke
177          elide         edile
178          elides        sedile
179          emes          seme
180          emir          rime
181          emit          time
182          emits         stime
183          enol          lone
184          era           are
185          ergo          ogre
186          eros          sore
187          ervil         livre
188          esnes         sense
189          eta           ate
190          etas          sate
191          etic          cite
192          etna          ante
193          even          neve
194          evil          live
195          eviler        relive
196          faced         decaf
197          fed           def
198          feeb          beef
199          fer           ref
200          fid           dif
201          fila          alif
202          fir           rif
203          fires         serif
204          fled          delf
205          flog          golf
206          flow          wolf
207          fool          loof
208          gab           bag
209          gad           dag
210          gal           lag
211          gals          slag
212          gam           mag
213          gan           nag
214          gar           rag
215          garb          brag
216          gas           sag
217          gat           tag
218          gateman       nametag
219          gater         retag
220          gats          stag
221          gay           yag
222          gel           leg
223          gelder        redleg
224          gem           meg
225          gen           neg
226          get           teg
227          gib           big
228          gid           dig
229          gip           pig
230          girt          trig
231          gnar          rang
232          gnat          tang
233          gnats         stang
234          gnaws         swang
235          gnus          sung
236          gob           bog
237          god           dog
238          golf          flog
239          gorp          prog
240          got           tog
241          grub          burg
242          gul           lug
243          gulp          plug
244          guls          slug
245          gum           mug
246          gums          smug
247          guns          snug
248          gut           tug
249          guv           vug
250          habus         subah
251          had           dah
252          hahs          shah
253          hales         selah
254          hap           pah
255          hay           yah
256          hep           peh
257          hey           yeh
258          hon           noh
259          hoop          pooh
260          hop           poh
261          imaged        degami
262          iron          nori
263          jar           raj
264          kay           yak
265          keel          leek
266          keels         sleek
267          keep          peek
268          keets         steek
269          kips          spik
270          kiths         shtik
271          knaps         spank
272          knar          rank
273          knits         stink
274          knob          bonk
275          know          wonk
276          korat         tarok
277          lab           bal
278          laced         decal
279          lad           dal
280          laded         dedal
281          lag           gal
282          lager         regal
283          laid          dial
284          lair          rial
285          lamina        animal
286          lap           pal
287          lares         seral
288          larum         mural
289          las           sal
290          laud          dual
291          led           del
292          lee           eel
293          leek          keel
294          leer          reel
295          lees          seel
296          leet          teel
297          leets         steel
298          leg           gel
299          leper         repel
300          les           sel
301          let           tel
302          leud          duel
303          lever         revel
304          levins        snivel
305          liar          rail
306          liard         drail
307          lied          deil
308          lin           nil
309          lion          noil
310          lira          aril
311          lit           til
312          live          evil
313          lived         devil
314          livre         ervil
315          lobo          obol
316          loid          diol
317          lone          enol
318          loof          fool
319          loom          mool
320          loons         snool
321          loop          pool
322          loops         spool
323          loot          tool
324          looter        retool
325          loots         stool
326          lop           pol
327          lotos         sotol
328          lug           gul
329          mac           cam
330          macs          scam
331          mad           dam
332          maes          seam
333          mag           gam
334          man           nam
335          map           pam
336          maps          spam
337          mar           ram
338          marc          cram
339          marcs         scram
340          mart          tram
341          mat           tam
342          maws          swam
343          may           yam
344          meed          deem
345          meet          teem
346          meg           gem
347          meter         retem
348          mho           ohm
349          mid           dim
350          mils          slim
351          mined         denim
352          mir           rim
353          mis           sim
354          mod           dom
355          mon           nom
356          mood          doom
357          mool          loom
358          moor          room
359          moot          toom
360          mop           pom
361          mor           rom
362          mos           som
363          mot           tom
364          mug           gum
365          mura          arum
366          mural         larum
367          mures         serum
368          mus           sum
369          muton         notum
370          muts          stum
371          nab           ban
372          nag           gan
373          nala          alan
374          nam           man
375          namer         reman
376          nametag       gateman
377          nap           pan
378          naps          span
379          naw           wan
380          neb           ben
381          neep          peen
382          neg           gen
383          nema          amen
384          net           ten
385          neve          even
386          neves         seven
387          new           wen
388          nib           bin
389          nil           lin
390          nimrod        dormin
391          nip           pin
392          nips          spin
393          nit           tin
394          nod           don
395          noh           hon
396          noil          lion
397          nolos         solon
398          nom           mon
399          nona          anon
400          nonet         tenon
401          nori          iron
402          nos           son
403          not           ton
404          notes         seton
405          notum         muton
406          now           won
407          nub           bun
408          nus           sun
409          nut           tun
410          nuts          stun
411          oat           tao
412          oba           abo
413          obol          lobo
414          oda           ado
415          ogre          ergo
416          ohm           mho
417          oohs          shoo
418          oot           too
419          orb           bro
420          oud           duo
421          ova           avo
422          pac           cap
423          pacer         recap
424          pad           dap
425          pah           hap
426          pal           lap
427          pals          slap
428          pam           map
429          pan           nap
430          pans          snap
431          par           rap
432          part          trap
433          parts         strap
434          pas           sap
435          pat           tap
436          paw           wap
437          paws          swap
438          pay           yap
439          pec           cep
440          peed          deep
441          peek          keep
442          peels         sleep
443          peen          neep
444          pees          seep
445          peh           hep
446          per           rep
447          perp          prep
448          pets          step
449          pig           gip
450          pin           nip
451          pins          snip
452          pis           sip
453          pit           tip
454          plug          gulp
455          poh           hop
456          pol           lop
457          pols          slop
458          pom           mop
459          pooh          hoop
460          pool          loop
461          pools         sloop
462          poons         snoop
463          port          trop
464          ports         strop
465          pot           top
466          pots          stop
467          pow           wop
468          pows          swop
469          prat          tarp
470          prep          perp
471          prod          dorp
472          prog          gorp
473          pud           dup
474          pupils        slipup
475          puris         sirup
476          pus           sup
477          put           tup
478          rag           gar
479          raga          agar
480          rail          liar
481          raj           jar
482          raja          ajar
483          ram           mar
484          rang          gnar
485          ranid         dinar
486          rank          knar
487          rap           par
488          raps          spar
489          rat           tar
490          rats          star
491          raw           war
492          ray           yar
493          rebus         suber
494          rebut         tuber
495          recap         pacer
496          recaps        spacer
497          redes         seder
498          redia         aider
499          redips        spider
500          redleg        gelder
501          redraw        warder
502          redrawer      rewarder
503          reed          deer
504          reel          leer
505          rees          seer
506          ref           fer
507          refed         defer
508          reffed        deffer
509          reflet        telfer
510          reflow        wolfer
511          regal         lager
512          regna         anger
513          reified       deifier
514          reined        denier
515          reknit        tinker
516          reknits       stinker
517          relaid        dialer
518          relit         tiler
519          relive        eviler
520          reman         namer
521          remeet        teemer
522          remit         timer
523          rennet        tenner
524          rep           per
525          repaid        diaper
526          repel         leper
527          repins        sniper
528          repot         toper
529          repots        stoper
530          res           ser
531          resod         doser
532          retag         gater
533          retem         meter
534          retool        looter
535          retros        sorter
536          revel         lever
537          reviled       deliver
538          reward        drawer
539          rewarder      redrawer
540          ria           air
541          rial          lair
542          rif           fir
543          rim           mir
544          rime          emir
545          roc           cor
546          rod           dor
547          rom           mor
548          rood          door
549          room          moor
550          rot           tor
551          rub           bur
552          sab           bas
553          sag           gas
554          saga          agas
555          sakis         sikas
556          sal           las
557          sallets       stellas
558          sap           pas
559          saps          spas
560          saros         soras
561          sat           tas
562          sate          etas
563          saved         devas
564          saw           was
565          scam          macs
566          scares        seracs
567          scram         marcs
568          seam          maes
569          secret        terces
570          seder         redes
571          sedile        elides
572          seed          dees
573          seeks         skees
574          seel          lees
575          seep          pees
576          seer          rees
577          seined        denies
578          sel           les
579          selah         hales
580          selahs        shales
581          seme          emes
582          semina        animes
583          senega        agenes
584          sense         esnes
585          ser           res
586          sera          ares
587          serac         cares
588          seracs        scares
589          seral         lares
590          serif         fires
591          serum         mures
592          seta          ates
593          seton         notes
594          seven         neves
595          sexed         dexes
596          sha           ahs
597          shad          dahs
598          shah          hahs
599          shales        selahs
600          shoo          oohs
601          shtik         kiths
602          sib           bis
603          sic           cis
604          sikas         sakis
605          sim           mis
606          sima          amis
607          sip           pis
608          sirra         arris
609          sirs          sris
610          sirup         puris
611          sit           tis
612          six           xis
613          skees         seeks
614          skeets        steeks
615          skips         spiks
616          skua          auks
617          slab          bals
618          slag          gals
619          slap          pals
620          sled          dels
621          sleek         keels
622          sleep         peels
623          sleeps        speels
624          sleet         teels
625          sleets        steels
626          slim          mils
627          slipup        pupils
628          slit          tils
629          sloid         diols
630          sloop         pools
631          sloops        spools
632          slop          pols
633          slug          guls
634          smart         trams
635          smug          gums
636          smuts         stums
637          snap          pans
638          snaps         spans
639          snaw          wans
640          snawed        dewans
641          snaws         swans
642          sned          dens
643          snib          bins
644          snip          pins
645          sniper        repins
646          snips         spins
647          snit          tins
648          snivel        levins
649          snool         loons
650          snoop         poons
651          snoops        spoons
652          snoot         toons
653          snot          tons
654          snow          wons
655          snub          buns
656          snug          guns
657          sob           bos
658          soba          abos
659          sod           dos
660          soda          ados
661          solon         nolos
662          som           mos
663          son           nos
664          soras         saros
665          sorb          bros
666          sore          eros
667          sorter        retros
668          sotol         lotos
669          sow           wos
670          spacer        recaps
671          spam          maps
672          span          naps
673          spank         knaps
674          spans         snaps
675          spar          raps
676          spas          saps
677          spat          taps
678          spay          yaps
679          spaz          zaps
680          spec          ceps
681          speed         deeps
682          speels        sleeps
683          spider        redips
684          spik          kips
685          spiks         skips
686          spin          nips
687          spins         snips
688          spirt         trips
689          spirts        strips
690          spit          tips
691          spool         loops
692          spools        sloops
693          spoons        snoops
694          sports        strops
695          spot          tops
696          spots         stops
697          sprat         tarps
698          sprits        stirps
699          spud          dups
700          sris          sirs
701          stab          bats
702          stag          gats
703          stang         gnats
704          star          rats
705          stared        derats
706          stat          tats
707          staw          wats
708          steed         deets
709          steek         keets
710          steeks        skeets
711          steel         leets
712          steels        sleets
713          stellas       sallets
714          step          pets
715          stet          tets
716          stew          wets
717          stime         emits
718          stink         knits
719          stinker       reknits
720          stirps        sprits
721          stob          bots
722          stool         loots
723          stop          pots
724          stoped        depots
725          stoper        repots
726          stops         spots
727          stot          tots
728          stow          wots
729          stows         swots
730          strap         parts
731          straw         warts
732          stressed      desserts
733          stria         airts
734          strips        spirts
735          strop         ports
736          strops        sports
737          strow         worts
738          struts        sturts
739          stub          buts
740          stum          muts
741          stums         smuts
742          stun          nuts
743          sturts        struts
744          sub           bus
745          subah         habus
746          suber         rebus
747          sulu          ulus
748          sum           mus
749          sun           nus
750          sung          gnus
751          sup           pus
752          swam          maws
753          swang         gnaws
754          swans         snaws
755          swap          paws
756          sward         draws
757          swat          taws
758          sway          yaws
759          swob          bows
760          swop          pows
761          swot          tows
762          swots         stows
763          tab           bat
764          tae           eat
765          tag           gat
766          tam           mat
767          tang          gnat
768          tao           oat
769          tap           pat
770          taps          spat
771          tar           rat
772          tared         derat
773          tarok         korat
774          tarp          prat
775          tarps         sprat
776          tas           sat
777          tats          stat
778          tav           vat
779          taw           wat
780          taws          swat
781          teed          deet
782          teel          leet
783          teels         sleet
784          teem          meet
785          teemer        remeet
786          teg           get
787          tel           let
788          telfer        reflet
789          ten           net
790          tenner        rennet
791          tenon         nonet
792          terces        secret
793          tets          stet
794          tew           wet
795          tide          edit
796          til           lit
797          tiler         relit
798          tils          slit
799          time          emit
800          timed         demit
801          timer         remit
802          tin           nit
803          tinker        reknit
804          tins          snit
805          tip           pit
806          tips          spit
807          tis           sit
808          tod           dot
809          tog           got
810          tom           mot
811          ton           not
812          tons          snot
813          too           oot
814          tool          loot
815          toom          moot
816          toons         snoot
817          top           pot
818          toped         depot
819          toper         repot
820          tops          spot
821          tor           rot
822          tort          trot
823          tots          stot
824          tow           wot
825          tows          swot
826          trad          dart
827          tram          mart
828          trams         smart
829          trap          part
830          tressed       dessert
831          trig          girt
832          trips         spirt
833          trop          port
834          trot          tort
835          trow          wort
836          tub           but
837          tuba          abut
838          tubed         debut
839          tuber         rebut
840          tug           gut
841          tun           nut
842          tup           put
843          ulus          sulu
844          vat           tav
845          vug           guv
846          wad           daw
847          wan           naw
848          wans          snaw
849          wap           paw
850          war           raw
851          ward          draw
852          warder        redraw
853          warts         straw
854          was           saw
855          wat           taw
856          wats          staw
857          way           yaw
858          wed           dew
859          wen           new
860          wet           tew
861          wets          stew
862          wolf          flow
863          wolfer        reflow
864          won           now
865          wonk          know
866          wons          snow
867          wop           pow
868          wort          trow
869          worts         strow
870          wos           sow
871          wot           tow
872          wots          stow
873          xis           six
874          yag           gay
875          yah           hay
876          yak           kay
877          yam           may
878          yap           pay
879          yaps          spay
880          yar           ray
881          yard          dray
882          yaw           way
883          yaws          sway
884          yeh           hey
885          yob           boy
886          zaps          spaz



RE: Emordnilap's - PhilOfPerth - 12-08-2024

(12-08-2024, 02:09 AM)bplus Wrote:
Code: (Select All)
Option _Explicit
_Title "emordnilap's found" ' b+ 2024-12-07

' I saw this   https://www.youtube.com/shorts/65_8t1OEZSc  and was inspired!

' an emordnilap is palindrome spelled backwards
' If a word spelled backwards is also a word the 2 words are an emordnilap pair.

' try the unixdict.txt file

Dim As Long index, fl, p, np, i, j, wCnt, test, emors
Dim buf$, wd$, b$
ReDim words$(1 To 1), emord$(1 To 1)
Open "unixdict.txt" For Binary As #1
' http://www.puzzlers.org/pub/wordlists/unixdict.txt
fl = LOF(1): buf$ = Space$(fl)
Get #1, , buf$
Close #1
p = 1: index = 0
While p < fl
    np = InStr(p, buf$, Chr$(10))
    If np Then
        wd$ = Mid$(buf$, p, np - p): Print wd$
        If Len(wd$) > 1 Then StrAppend words$(), wd$: wCnt = wCnt + 1
        p = np + 1
    Else
        p = fl
    End If
Wend
For i = 1 To wCnt
    wd$ = words$(i)
    b$ = "": j = 1
    While j <= Len(wd$)
        b$ = Mid$(wd$, j, 1) + b$
        j = j + 1
    Wend
    If b$ <> wd$ Then ' NOT Palindrome! So lookup to see if word in words()
        test = Find&(words$(), b$)
        If test Then
            If Len(wd$) > 3 Then
                StrAppend emord$(), wd$: emors = emors + 1
                Print emors, wd$, b$
                'If emors Mod 20 = 19 Then Sleep: Cls
            End If
        End If
    End If
Next
Sleep

_Title "Emordnilap Machine"
Screen _NewImage(700, 700, 32)
_ScreenMove 340, 20
Randomize Timer
Dim As Long r
Do
    r = Int(Rnd * emors) + 1
    EmordnilapMachine emord$(r)
    _Delay .2
Loop Until _KeyDown(27)

Sub EmordnilapMachine (eword$)
    Dim As Long cx, cy, wl, th, tw, xoff, l
    Dim As Double a, mid, r
    cx = _Width / 2: cy = _Height / 2: wl = Len(eword$): th = 64
    mid = wl / 2
    For a = 0 To 2 * _Pi - .001 Step _Pi(2 / 360)
        Cls
        For l = 1 To wl
            r = th * ((l - .5) - mid)
            Text cx + r * Cos(a) - 16, cy + r * Sin(a) - 16, th, &HFFFFFFFF, Mid$(eword$, l, 1)
        Next
        If Abs(a - _Pi) < .001 Or Abs(a - 2 * _Pi - .001) < .001 Then _Delay .2
        _Display
        _Limit 30
    Next
End Sub

Function Find& (SortedArr$(), x$)
    Dim As Long low, hi, test
    low = LBound(SortedArr$): hi = UBound(SortedArr$)
    While low <= hi
        test = Int((low + hi) / 2)
        If SortedArr$(test) = x$ Then
            Find& = test: Exit Function
        Else
            If SortedArr$(test) < x$ Then low = test + 1 Else hi = test - 1
        End If
    Wend
End Function

Sub StrAppend (arr() As String, addItem$) ' update 2024-12-06 to test for empty first slot
    If arr(LBound(arr)) = "" Then
        arr(LBound(arr)) = addItem$
    Else
        ReDim _Preserve arr(LBound(arr) To UBound(arr) + 1) As String
        arr(UBound(arr)) = addItem$
    End If
End Sub

Sub Text (x, y, textHeight, K As _Unsigned Long, txt$)
    Dim fg As _Unsigned Long, bg As _Unsigned Long, cur&, i&
    fg = _DefaultColor: bg = _BackgroundColor: cur& = _Dest
    i& = _NewImage(8 * Len(txt$), 16, 32)
    _Dest i&: Color K, _RGBA32(0, 0, 0, 0): _PrintString (0, 0), txt$
    _PutImage (x, y)-Step(Len(txt$) * textHeight / 2, textHeight), i&, cur&
    Color fg, bg: _FreeImage i&: _Dest cur&
End Sub

Seems like there are way more Palindromes than Emordnilaps.

zip has source and unixdict.txt file for a word list to check.

Sorry bplus; I posted my code to a different thread because I didn't want to "corrupt" yours with my puny effort- especially when it doesn't work!  Blush
I'll try and get it deleted.