12-15-2017, 06:29 PM
Post: #11
 (Print Post)
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 Snippet: [Select]
_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
TYPE palData
    text AS STRING * 200
    center AS LONG

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
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
                        EXIT WHILE
                    END IF
                    EXIT WHILE
                END IF
            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
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)
display d$()

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

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

' 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

'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
        loadString$ = ""
    END IF

'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)
        IF ub - lb + 1 > 20 THEN
                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)
                    END IF
                END IF
                prevrow = row 'store previous row value
        END IF

'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
        textFilter$ = r$
    END IF

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 File(s) Image(s)

For a bad joke 
worse than Pete's Big Grin
Find all posts by this user
Like Post
12-17-2017, 10:34 PM
Post: #12
 (Print Post)
Found this HUGE list of english words:

Attached File(s)
.zip (Size: 1.24 MB / Downloads: 0)

Interpreter - Hex Editor - Utilities -

QB45 files: - QB64shell - Some old QB64 versions: - 
Find all posts by this user
Like Post
12-18-2017, 10:33 AM (This post was last modified: 12-18-2017 10:45 AM by bplus.)
Post: #13
 (Print Post)
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:

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.

For a bad joke 
worse than Pete's Big Grin
Find all posts by this user
Like Post

Forum Jump:

User(s) browsing this thread: 1 Guest(s)

QB64 Member Project - Blokus
QB64 Member Project - Color Rotating Text
QB64 Member Project - ARB Checkers
QB64 Member Project - Sabotage
QB64 Member Project - Martin Fractals version one
QB64 Member Project - Isolation
QB64 Member Project - Spiro Roses
QB64 Member Project - Point Blank
QB64 Member Project - Pivot version two
QB64 Member Project - Domain
QB64 Member Project - Color Triangles
QB64 Member Project - OpenGL Triangles
QB64 Member Project - Connect Four
QB64 Member Project - Full Color LED Sign
QB64 Member Project - RGB Color Wheel
QB64 Member Project - Amazon
QB64 Member Project - Red Scrolling LED Sign
QB64 Member Project - MAPTRIANGLE
QB64 Member Project - Kings Valley verion one
QB64 Member Project - Pivet version one
QB64 Member Project - Rubix's Magic
QB64 Member Project - Bowditch curve
QB64 Member Project - STxAxTIC 3D World
QB64 Member Project - Algeria Weather
QB64 Member Project - Kings Vallery version two
QB64 Member Project - Dakapo
QB64 Member Project - 9 Board
QB64 Member Project - Dreamy Clock
QB64 Member Project - Score 4
QB64 Member Project - Splatter
QB64 Member Project - Othello
QB64 Member Project - Swirl
QB64 Member Project - Inside Moves
QB64 Member Project - Overboard
QB64 Member Project - Foursight
QB64 Member Project - Martin Fractals version four
QB64 Member Project - Qubic
QB64 Member Project - Quarto
QB64 Member Project - Kobolts Monopoly
QB64 Member Project - Touche
QB64 Member Project - Input
QB64 Member Project - Spinning Color Wheel
QB64 Member Project - Basic Dithering
QB64 Member Project - Line Thickness
QB64 Member Project - Rotating Background
QB64 Member Project - Martin Fractals version two
QB64 Member Project - Exit
QB64 Member Project - Kings Court
QB64 Member Project - Martin Fractals version three