Winners never quit and quitters never win.
Please provide some examples of proverbs, quips, catch phrases, punch lines having a similar structure i.e. A B C D C' B' A'.
A', B', C' are grammatical alterations of (or exactly equal to) A, B, C.
D stands for one of the (and, but, while ) or (comma, hyphen, empty space)
The program reads the html file from the Wikipedia List of Proverbs article and narrows down, for human perusal, those proverbs the initial letters of whose words form a palindrome.
DefDbl A-Z
Dim crlf$
Private Sub Form_Load()
Text1.Text = ""
crlf$ = Chr(13) + Chr(10)
Form1.Visible = True
Open "proverbs.txt" For Input As #1
Do
Line Input #1, l$
p$ = ""
For i = 1 To Len(l$)
c$ = Mid(l, i, 1)
If c = "<" Then lvl = lvl + 1
If c = ">" Then lvl = lvl - 1
If lvl = 0 Then p = p + c
Next
While Left(p, 1) = ">"
p = Mid(p, 2)
Wend
ix = InStr(p, ">")
If ix Then p = Left(p, ix - 1)
p = LCase(LTrim(RTrim(p)))
chk$ = Left(p, 1)
p2$ = p + " "
While p2 > ""
ix = InStr(p2, " ")
If ix Then
p2 = LTrim(Mid(p2, ix + 1))
While InStr("abcdefghijklmnopqrstuvwxyz", Left(p2, 1)) = 0
p2 = Mid(p2, 2)
Wend
If p2 > "" Then
chk = chk + Left(p2, 1)
End If
End If
Wend
If isPalin(chk) Then
p = LTrim(RTrim(p))
If Len(p) > 1 Then
Text1.Text = Text1.Text & p & crlf
DoEvents
End If
End If
Loop Until EOF(1)
Close
Text1.Text = Text1.Text & "done"
DoEvents
End Sub
Function isPalin(s$)
good = 1
For i = 1 To Len(s$) / 2
If Mid$(s$, i, 1) <> Mid$(s$, Len(s$) + 1 - i, 1) Then good = 0: Exit For
Next
isPalin = good
End Function
The "winners never quit" proverb doesn't seem to be present at all, and many red herrings are present in this complete list:
enough is enough
failing to plan is planning to fail
first things first
forewarned is forearmed
manners maketh man
many a mickle makes a muckle
never say never
practice makes perfect
slow but sure
speech is silver
the
time will tell
Only "failing to plan is planning to fail" seems to fit the format asked for.
|
|
Posted by Charlie
on 2015-04-24 12:59:57 |
computer plus human finds only one
