FALSE*TRUE= "USA state"
Fill in the correct name of the state, solve the alphametic and comment on the puzzle's title.
DefDbl A-Z
Dim crlf$
Private Sub Form_Load()
Form1.Visible = True
Text1.Text = ""
crlf = Chr$(13) + Chr$(10)
Open "us states.txt" For Input As #1
Do
Line Input #1, ln$
DoEvents
ct = 0
For ix = 1 To Len(ln)
If Mid(ln, ix, 1) >= "A" And Mid(ln, ix, 1) <= "Z" Then
ct = ct + 1
If ct = 2 Then Exit For
Else
ct = 0
End If
Next
statename$ = LTrim(RTrim(Left(ln, ix - 2)))
statename = LCase(statename)
If InStr(statename, " ") = 0 Then
If Len(statename) = 8 Or Len(statename) = 9 Then
Text1.Text = Text1.Text & statename & crlf
ReDim used(9)
For f = 1 To 9
If used(f) = 0 Then
used(f) = 1
For t = 1 To 9
If used(t) = 0 Then
used(t) = 1
For a = 0 To 9
If used(a) = 0 Then
used(a) = 1
For l = 0 To 9
If used(l) = 0 Then
used(l) = 1
For s = 0 To 9
If used(s) = 0 Then
used(s) = 1
Text2.Text = f & Str(t) & Str(a) & Str(l) & Str(s)
DoEvents
For e = 0 To 9
If used(e) = 0 Then
used(e) = 1
mult1 = 10000 * f + 1000 * a + 100 * l + 10 * s + e
DoEvents
For r = 0 To 9
If used(r) = 0 Then
used(r) = 1
For u = 0 To 9
If used(u) = 0 Then
used(u) = 1
mult2 = 1000 * t + 100 * r + 10 * u + e
prod = mult1 * mult2
p$ = LTrim(Str(prod))
good = 1
c$ = LTrim(Str(f)): ix = 0
Do
ix = InStr(ix + 1, p, c)
ix2 = InStr(ix2 + 1, statename, "f")
If ix <> ix2 Then good = 0: GoTo nextu
Loop Until ix = 0
c$ = LTrim(Str(a)): ix = 0
Do
ix = InStr(ix + 1, p, c)
ix2 = InStr(ix2 + 1, statename, "a")
If ix <> ix2 Then good = 0: GoTo nextu
Loop Until ix = 0
c$ = LTrim(Str(l)): ix = 0
Do
ix = InStr(ix + 1, p, c)
ix2 = InStr(ix2 + 1, statename, "l")
If ix <> ix2 Then good = 0: GoTo nextu
Loop Until ix = 0
c$ = LTrim(Str(s)): ix = 0
Do
ix = InStr(ix + 1, p, c)
ix2 = InStr(ix2 + 1, statename, "s")
If ix <> ix2 Then good = 0: GoTo nextu
Loop Until ix = 0
c$ = LTrim(Str(e)): ix = 0
Do
ix = InStr(ix + 1, p, c)
ix2 = InStr(ix2 + 1, statename, "e")
If ix <> ix2 Then good = 0: GoTo nextu
Loop Until ix = 0
c$ = LTrim(Str(t)): ix = 0
Do
ix = InStr(ix + 1, p, c)
ix2 = InStr(ix2 + 1, statename, "t")
If ix <> ix2 Then good = 0: GoTo nextu
Loop Until ix = 0
c$ = LTrim(Str(r)): ix = 0
Do
ix = InStr(ix + 1, p, c)
ix2 = InStr(ix2 + 1, statename, "r")
If ix <> ix2 Then good = 0: GoTo nextu
Loop Until ix = 0
c$ = LTrim(Str(u)): ix = 0
Do
ix = InStr(ix + 1, p, c)
ix2 = InStr(ix2 + 1, statename, "u")
If ix <> ix2 Then good = 0: GoTo nextu
Loop Until ix = 0
If good Then
Text1.Text = Text1.Text & f & a & l & s & e & " " & t & r & u & e & " " & Str(prod) & crlf
End If
nextu:
used(u) = 0
End If
Next
used(r) = 0
End If
Next
used(e) = 0
End If
Next
used(s) = 0
End If
Next
used(l) = 0
End If
Next
used(a) = 0
End If
Next
used(t) = 0
End If
Next
used(f) = 0
End If
Next
End If
End If
Loop Until EOF(1)
Close 1
Text1.Text = Text1.Text & crlf & " done"
End Sub
does not fully check the cryptogram for the state, but narrows down the choices for manual consideration:
arkansas
colorado
delaware
illinois
louisiana
maryland
michigan
40567 8217 333339039
minnesota
missouri
nebraska
oklahoma
40637 2857 116099909
tennessee
75280 1460 109908800
wisconsin
34057 2687 91511159
42607 1387 59095909
62407 1587 99039909
done
For example Michigan is listed since its first occurrence of a, for zero, is in the 7th position, as is the zero in the product. (There was no strict length check.)
Only Tennessee's product was a cryptogram for the state:
75280 1460 109908800
FALSE TRUE TENNESSEE
The title: 5 76993 408621
A FUNNY RESULT
Edited on June 5, 2015, 7:36 am
|
|
Posted by Charlie
on 2015-06-04 14:28:11 |
computer aided solution
