Palindromes
#1
Code:
_TITLE "Palindromes finding by bplus 2017-12-08"
'for Erik
index = 0: t = TIMER
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: m = 1: index = 0
WHILE p < fl
    np = INSTR(p, buf$, CHR$(10))
    wd$ = MID$(buf$, p, np - p)
    IF LEN(wd$) > 1 THEN
        b$ = "": i = 1
        WHILE i <= LEN(wd$)
            b$ = MID$(wd$, i, 1) + b$
            i = i + 1
        WEND
        IF b$ = wd$ THEN
            index = index + 1
            IF LEN(pal$) THEN pal$ = pal$ + STR$(index) + ". " + b$ + " " ELSE pal$ = " 1. " + b$
            IF LEN(pal$) > m * 50 THEN m = m + 1: pal$ = pal$ + CHR$(10)
        END IF
    END IF
    IF np THEN p = np + 1 ELSE p = fl
WEND
PRINT " Found"; index; " palindromes in"; TIMER - t; " secs."
PRINT: PRINT pal$
SLEEP

Unfortunately this file doesn't have very interesting palindromes or very many (see screen shot).

Palindromes are more fun in sentences:
A man, a plan, a canal: Panama!   (case, spaces and punctuation ignored)

So the challenge is to make (or find) fun sentences that are palindromes.

hmm... I wonder if the Alice in Wonderland has any?

Append: You can now get a copy of the word file I am using for Anagrams and here Palindromes, unixdict.txt, link:
http://www.thejoyfulprogrammer.com/qb64/...59#pid5506
post Sorting algorithms for ya


Attached Files Thumbnail(s)

B += x
Reply
#2
Cool, thanks. My favorite palindrome:

  Satan, oscillate my metallic sonatas.

What's yours?
dndbbs project:

Links to my MUD: (strictly 16-bit); AKA XP:

Dndbbs executables
http://www.filegate.net/pdn/pdnbasic/dnd50a1e.zip

Dndbbs source
http://www.filegate.net/pdn/pdnbasic/dnd50a1s.zip

Dndbbs upgrade
http://www.filegate.net/pdn/pdnbasic/dnd50a1u.zip

DNDDOOR - https://bit.ly/EriksDNDDoor DUNGEON - https://bit.ly/EriksDungeon
Interpreter - https://bit.ly/EriksSICK Hex Editor - https://bit.ly/EriksHexEditor Utilities - https://bit.ly/EriksUtils
QB45 files: - https://bit.ly/EriksQB45 QB64shell - https://bit.ly/QB64shell Some old QB64 versions: - https://bit.ly/OldQB64
Reply
#3
Code to search and display two 4-letter word Palindromes:

Code:
CLS
DIM words(5000) AS STRING * 4
OPEN "text2.dic" FOR INPUT AS #1
x = 0
DO
    IF EOF(1) THEN EXIT DO
    LINE INPUT #1, a$
    a$ = RTRIM$(a$)
    IF LEN(a$) = 4 THEN
        IF LCASE$(a$) = a$ THEN
            x = x + 1
            words(x) = a$
        END IF
    END IF
LOOP

FOR l1 = 1 TO x
    FOR l2 = l1 + 1 TO x
        x1$ = LCASE$(words(l1))
        x2$ = LCASE$(words(l2))
        p$ = x1$ + " " + x2$

        b$ = ""
        FOR l = LEN(p$) TO 1 STEP -1
            b$ = b$ + MID$(p$, l, 1)
        NEXT
        IF p$ = b$ THEN PRINT p$
    NEXT
NEXT
END

And one for 5-letter words:

Code:
CLS
DIM words(6000) AS STRING * 5
OPEN "text2.dic" FOR INPUT AS #1
x = 0
DO
    IF EOF(1) THEN EXIT DO
    LINE INPUT #1, a$
    a$ = RTRIM$(a$)
    IF LEN(a$) = 5 THEN
        IF LCASE$(a$) = a$ THEN
            x = x + 1
            words(x) = a$
        END IF
    END IF
LOOP

FOR l1 = 1 TO x
    FOR l2 = l1 + 1 TO x
        x1$ = LCASE$(words(l1))
        x2$ = LCASE$(words(l2))
        p$ = x1$ + " " + x2$

        b$ = ""
        FOR l = LEN(p$) TO 1 STEP -1
            b$ = b$ + MID$(p$, l, 1)
        NEXT
        IF p$ = b$ THEN PRINT p$
    NEXT
NEXT
END


Attached Files .zip   DICTION.ZIP (Size: 256.17 KB / Downloads: 2)
dndbbs project:

Links to my MUD: (strictly 16-bit); AKA XP:

Dndbbs executables
http://www.filegate.net/pdn/pdnbasic/dnd50a1e.zip

Dndbbs source
http://www.filegate.net/pdn/pdnbasic/dnd50a1s.zip

Dndbbs upgrade
http://www.filegate.net/pdn/pdnbasic/dnd50a1u.zip

DNDDOOR - https://bit.ly/EriksDNDDoor DUNGEON - https://bit.ly/EriksDungeon
Interpreter - https://bit.ly/EriksSICK Hex Editor - https://bit.ly/EriksHexEditor Utilities - https://bit.ly/EriksUtils
QB45 files: - https://bit.ly/EriksQB45 QB64shell - https://bit.ly/QB64shell Some old QB64 versions: - https://bit.ly/OldQB64
Reply
#4
Quote:Satan, oscillate my metallic sonatas.

Ha! Where did that come from? 

I think I gave you my one of the best I've seen. We were discussing palindromes at JB and Richard had us redefining our rules for case, spaces and punctuation so all these clever expressions like the Panama canal one would be allowed.
B += x
Reply
#5
http://www.palindromelist.net/
dndbbs project:

Links to my MUD: (strictly 16-bit); AKA XP:

Dndbbs executables
http://www.filegate.net/pdn/pdnbasic/dnd50a1e.zip

Dndbbs source
http://www.filegate.net/pdn/pdnbasic/dnd50a1s.zip

Dndbbs upgrade
http://www.filegate.net/pdn/pdnbasic/dnd50a1u.zip

DNDDOOR - https://bit.ly/EriksDNDDoor DUNGEON - https://bit.ly/EriksDungeon
Interpreter - https://bit.ly/EriksSICK Hex Editor - https://bit.ly/EriksHexEditor Utilities - https://bit.ly/EriksUtils
QB45 files: - https://bit.ly/EriksQB45 QB64shell - https://bit.ly/QB64shell Some old QB64 versions: - https://bit.ly/OldQB64
Reply
#6
Quote:I think I gave you my one of the best I've seen. We were discussing palindromes at JB and Richard had us redefining our rules for case, spaces and punctuation so all these clever expressions like the Panama canal one would be allowed.

What's 'JB'?
dndbbs project:

Links to my MUD: (strictly 16-bit); AKA XP:

Dndbbs executables
http://www.filegate.net/pdn/pdnbasic/dnd50a1e.zip

Dndbbs source
http://www.filegate.net/pdn/pdnbasic/dnd50a1s.zip

Dndbbs upgrade
http://www.filegate.net/pdn/pdnbasic/dnd50a1u.zip

DNDDOOR - https://bit.ly/EriksDNDDoor DUNGEON - https://bit.ly/EriksDungeon
Interpreter - https://bit.ly/EriksSICK Hex Editor - https://bit.ly/EriksHexEditor Utilities - https://bit.ly/EriksUtils
QB45 files: - https://bit.ly/EriksQB45 QB64shell - https://bit.ly/QB64shell Some old QB64 versions: - https://bit.ly/OldQB64
Reply
#7
JustBasic
I like to program in BASIC
With code that is simple and slick
I learnt it in school
And it is still cool
So it is my number one pick
Reply
#8
Ok, thanks. Is it any good? Should I use it?

I mean I have used various dialects of BASIC, including GW-Basic, FreeBasic, Xbasic, PowerBasic,
QB 4.5, PDS 7.10, VB 1, 5, and 6, but I've always found QB64 to be the best one around..
dndbbs project:

Links to my MUD: (strictly 16-bit); AKA XP:

Dndbbs executables
http://www.filegate.net/pdn/pdnbasic/dnd50a1e.zip

Dndbbs source
http://www.filegate.net/pdn/pdnbasic/dnd50a1s.zip

Dndbbs upgrade
http://www.filegate.net/pdn/pdnbasic/dnd50a1u.zip

DNDDOOR - https://bit.ly/EriksDNDDoor DUNGEON - https://bit.ly/EriksDungeon
Interpreter - https://bit.ly/EriksSICK Hex Editor - https://bit.ly/EriksHexEditor Utilities - https://bit.ly/EriksUtils
QB45 files: - https://bit.ly/EriksQB45 QB64shell - https://bit.ly/QB64shell Some old QB64 versions: - https://bit.ly/OldQB64
Reply
#9
RE: Just Basic - should I use it?

This is a good topic that deserves it's own thread, so I will start one.
http://www.thejoyfulprogrammer.com/qb64/...05#pid5522
B += x
Reply
#10
From the file I am calling "P Data.txt" I was able to extract 50 unique (in permutation of letters used) Palindromes in about .10 secs on my dinosaur. Can you find more (that are not just a variation of punctuation) ? faster ?

The file comes from copy of first html page at Palindromes site Erik gave us. see "P Data.txt" attachment (there are far too many tags for Walter's forum to display the file correctly!)

I like: "A nut for a jar of tuna."

Oops! I have one palindrome repeated, which? So 49 unique Palindromes...


Attached Files Thumbnail(s)

.txt   P data.txt (Size: 64.99 KB / Downloads: 6)
B += x
Reply
#11
I have created a new algorithm for finding palindromes in large gob of data and eager to share with you guys!

It is easy to determine if a given string is a palindrome but finding palindromes in a very large string, a little more tricky, I think I have found a very lovely method for doing it and here is how it would be applied to the, P data.txt, file:
Code:
_TITLE "The Hunt for the Middle of a Palindrome by bplus 2017-12-15"
' I have been thinking about Steve's approach for finding Palindromes from the, P data.txt, file.
' I was lucky to find the Plaindromes were exactly started and ended between / symbols. What if
' they weren't? It is easy to determine whether a given string is a Palindrome or not, not so
' easy is finding a Palindrome in a gob of letters! That was the harder problem for which Steve
' had worked up a solution and that problem does come with an additional one of not finding over
' and over again the smaller Palindromes inside the biggest one.
'    As I understand Steve's code, he was testing each letter in the file to see if it were the
' start of a Palindrome of length L, after running one value for L, he'd go through the whole file
' again testing each letter with the next L value. So in the end you can not tell which Palindrones
' found were just smaller inner ones of Palindromes already found at the larger size.
'   What if we examined each letter in the file to see not whether it was the start of a Palindrome
' but the middle of one! Then we would only have to go through the file once and then we would not
' mistake one Palindrome found being just a smaller one of a bigger one we had already found (or
' vice versa depending if we were increasing or dcecreasing our L values.) There is only one middle
' for each unique "outermost" Palindrome. BUT there are 2 kinds of middles, the odd middle of a
' Palindrome of an odd numered length and the even middle of a Palindrome of an even numbered
' length.

' OK get the file loaded into a string
DEFLNG A-Z
TYPE palData
    text AS STRING * 200
    center AS LONG
END TYPE

DIM SHARED fl 'file length
DIM SHARED fs$ 'file string before, then after filtering
DIM SHARED lcfs$ 'lower case filtered file string

t# = TIMER
' P Data.txt is a html copy of the first page at  http://www.palindromelist.net
fLoad "P Data.txt", fs$
IF fs$ = "" THEN INPUT "No file loaded, press enter to end"; damn$: END

'small test strings
'fs$ = "dxtxd1234"
'fs$ = "uvwycxttxc"
'fs$ = "A man, a plan, a canal: Panama!" ' fix case bug

fs$ = textFilter$(fs$) 'remove characters not meant to be printed eg asc < 32
'PRINT "text: "; fs$
lcfs$ = LCASE$(fs$) 'to save a ton of LCASE$ calls, work with this string for locating
'PRINT "lc text: "; lcfs$
DIM p(2500) AS palData

i = 2: palTop = 0: fl = LEN(fs$)
WHILE i < fl
    'is char at i a letter
    pal$ = ""
    center$ = MID$(lcfs$, i, 1)
    'PRINT "i ="; i
    IF isLetter%(center$) THEN
        'PRINT "Is letter "; center$
        right = nextRight(i)
        'PRINT "right "; right; MID$(lcfs$, right, 1)
        IF right <> 0 THEN
            IF center$ = MID$(lcfs$, right, 1) THEN 'an even pal?
                left = nextLeft(i): right = nextRight(right)
            ELSE 'an odd pal?
                left = nextLeft(i)
                'PRINT "left"; left; MID$(lcfs$, left, 1)
            END IF
            WHILE MID$(lcfs$, left, 1) = MID$(lcfs$, right, 1) 'an pal started!
                'grow it
                pal$ = MID$(fs$, left, right - left + 1)
                'PRINT "growing "; pal$
                nl = nextLeft(left): nr = nextRight(right)
                IF nl <> 0 AND nr <> 0 THEN
                    IF MID$(lcfs$, nl, 1) = MID$(lcfs$, nr, 1) THEN
                        left = nl: right = nr
                    ELSE
                        EXIT WHILE
                    END IF
                ELSE
                    EXIT WHILE
                END IF
            WEND
            IF LEN(pal$) > 3 THEN 'most of the just is 4 letters
                'i = right     no skipping! it is possible to have overlapping palindrones (with different centers)
                palTop = palTop + 1
                p(palTop).text = pal$
                p(palTop).center = i
                'PRINT "Grown "; pal$
            END IF
        END IF 'have letter/digit to the right
    END IF ' we are on a letter/digit and not on a space or other punctuation
    i = i + 1
WEND
PRINT TIMER - t#; " secs, number found"; palTop
INPUT " Press enter for display of Palindromes found..."; show$
DIM d$(1 TO palTop)
FOR i = 1 TO palTop
    d$(i) = RIGHT$(SPACE$(5) + STR$(i), 5) + ". [" + RIGHT$(SPACE$(5) + STR$(p(i).center), 5) + "] " + RTRIM$(p(i).text)
NEXT
display d$()
END

FUNCTION nextRight (position)
    right = position + 1
    WHILE right <= fl
        IF isLetter%(MID$(lcfs$, right, 1)) = 0 THEN right = right + 1 ELSE EXIT WHILE
    WEND
    IF right > fl THEN nextRight = 0 ELSE nextRight = right
END FUNCTION

FUNCTION nextLeft (position)
    left = position - 1
    WHILE left >= 1
        IF isLetter%(MID$(lcfs$, left, 1)) = 0 THEN left = left - 1 ELSE EXIT WHILE
    WEND
    IF left < 1 THEN nextLeft = 0 ELSE nextLeft = left
END FUNCTION


' is the character a digit or a lower case letter ?
FUNCTION isLetter% (char$)
    IF char$ <> "" THEN
        'test$ = LCASE$(char$)      'all converted already
        ac% = ASC(char$)
        IF (ac% > 96 AND ac% < 123) OR (ac% > 47 AND ac% < 58) THEN isLetter% = -1
    END IF
END FUNCTION

'load a file into a string in one gulp!
SUB fLoad (fileName$, loadString$)
    IF _FILEEXISTS(fileName$) THEN
        OPEN fileName$ FOR BINARY AS #1
        fileLength& = LOF(1): loadString$ = SPACE$(fileLength&)
        GET #1, , loadString$
        CLOSE #1
    ELSE
        loadString$ = ""
    END IF
END SUB

'display an array with scroller (from Wiki Help)
SUB display (arr() AS STRING)
    lb = LBOUND(arr): ub = UBOUND(arr)
    IF ub - lb + 1 < 21 THEN top = ub ELSE top = lb + 19
    CLS: PRINT "press any key to quit scroller..."
    LOCATE 2, 1
    FOR i = lb TO top
        PRINT arr(i)
    NEXT
    DO
        IF ub - lb + 1 > 20 THEN
            DO WHILE _MOUSEINPUT
                IF row >= lb THEN row = row + _MOUSEWHEEL ELSE row = lb 'prevent under scrolling
                IF row > ub - 19 THEN row = ub - 19 'prevent over scrolling
                IF prevrow <> row THEN 'look for a change in row value
                    IF row >= lb AND row <= ub - 19 THEN
                        CLS: PRINT "press any key to quit scroller..."
                        LOCATE 2, 1
                        FOR n = row TO row + 19
                            PRINT arr(n)
                        NEXT
                    END IF
                END IF
                prevrow = row 'store previous row value
            LOOP
        END IF
    LOOP UNTIL INKEY$ > ""
END SUB

'remove unprintable characters, or ones that shouldn't be
FUNCTION textFilter$ (s$)
    IF LEN(s$) THEN
        r$ = "": ls = LEN(s$): i = 1
        WHILE i <= ls
            ac% = ASC(s$, i)
            IF ac% > 31 THEN r$ = r$ + CHR$(ac%)
            i = i + 1
        WEND
        textFilter$ = r$
    END IF
END FUNCTION

Screen shot is a sample with the longest palindrome. The numbers in [] brackets are the locations in the long string of the palindrome's center. Notice large palindromes often have smaller palindromes embedded in them (not sharing the same center as the outer one, in fact, it is possible to have overlapping ones).


Attached Files Thumbnail(s)

B += x
Reply
#12
Found this HUGE list of english words:


Attached Files .zip   words.zip (Size: 1.24 MB / Downloads: 2)
dndbbs project:

Links to my MUD: (strictly 16-bit); AKA XP:

Dndbbs executables
http://www.filegate.net/pdn/pdnbasic/dnd50a1e.zip

Dndbbs source
http://www.filegate.net/pdn/pdnbasic/dnd50a1s.zip

Dndbbs upgrade
http://www.filegate.net/pdn/pdnbasic/dnd50a1u.zip

DNDDOOR - https://bit.ly/EriksDNDDoor DUNGEON - https://bit.ly/EriksDungeon
Interpreter - https://bit.ly/EriksSICK Hex Editor - https://bit.ly/EriksHexEditor Utilities - https://bit.ly/EriksUtils
QB45 files: - https://bit.ly/EriksQB45 QB64shell - https://bit.ly/QB64shell Some old QB64 versions: - https://bit.ly/OldQB64
Reply
#13
The Business of Building Better or Best Palindromes:

List of supplies:

1) First we need giant word list that includes common proper names and places.
We've seen several lists now but from which will we use? 
Well! It just so happens we have done a little project that combines many files into one! How convenient, just what we need to get the biggest list without repetition.

I think things started getting interesting around here:
http://www.thejoyfulprogrammer.com/qb64/...3259754878

2) A list of words that are palindromes, these can be the centers of longer ones.

3) A list of words which reversed are also words, this is important for extending Palindromes outwards. (we get paid by the letter, digits not so much, punctuation even less).

4) Combinations of words that when spelled backwards form bigger words or whole words (and vice versa).
I don't many combinations beyond 3, words like Panama ... a man a p... very valuable!

5) Rating system: what makes a good Palindrome
- No gobblely-gook! Words and meaningful use of digits.
+ points for using commonly known words, names, places (I guess different cultures will judge this differently).
+ lots of points for number of letters used
+ points for using digits cleverly (since any number can be "palindromed" without need of wit) say like using the fact that 31 and 13 are prime, hey are they the 2 closest primes that are also palindromes?
+ bonus points for funny (also depends individuals judgment).
+ ...

What have I forgotten?

Oh we can use my Palindrome finder algorithm to plunder Palindromes from other sources. That might be a good source for longer word combinations.
B += x
Reply