Looking for old program or help recreating it

[random1]

Wow, 100 times more productive.  I should have some time tomorrow to update my end.

Many thanks for everything.

R1   

[random1]

Ran a quick test using real data, amazing!!!
R1.

[STxAxTIC]

Glad it's looking better and better r1!

It's still evolving little by little: today I re-included the order-1 alphabets (so literally just 0 and 1) and this thing's putting game improved yet again. I also improved a few things about how it looks, and it also reports on its best streak now too, cause why not? Anyway, here's the latest and greatest:

Code: QB64: [Select]

1. Option _Explicit
2.  
3. Screen _NewImage(120, 40)
4.  
5. ' Version: 13
6.  
7. Type LetterBin
8.     Signature As String
9.     Count As Integer
10. End Type
11.  
12. Dim Shared Alphabet1(2) As LetterBin ' 0 1
13. Dim Shared Alphabet2(4) As LetterBin ' 00 01 10 11
14. Dim Shared Alphabet3(8) As LetterBin ' 000 001 010 011 100 101 110 111
15. Dim Shared Alphabet4(16) As LetterBin ' etc.
16. Dim Shared Alphabet5(32) As LetterBin
17. Dim Shared Alphabet6(64) As LetterBin
18. Dim Shared Alphabet7(128) As LetterBin
19. Dim Shared Alphabet8(256) As LetterBin
20. Dim Shared Alphabet9(512) As LetterBin
21. Dim Shared Alphabet10(1024) As LetterBin
22. Dim Shared Alphabet11(2048) As LetterBin
23. Dim Shared Alphabet12(4096) As LetterBin
24. Dim Shared Alphabet13(8192) As LetterBin
25.  
26. Alphabet1(1).Signature = "0"
27. Alphabet1(2).Signature = "1"
28. Call NewAlphabet(Alphabet1(), Alphabet2())
29. Call NewAlphabet(Alphabet2(), Alphabet3())
30. Call NewAlphabet(Alphabet3(), Alphabet4())
31. Call NewAlphabet(Alphabet4(), Alphabet5())
32. Call NewAlphabet(Alphabet5(), Alphabet6())
33. Call NewAlphabet(Alphabet6(), Alphabet7())
34. Call NewAlphabet(Alphabet7(), Alphabet8())
35. Call NewAlphabet(Alphabet8(), Alphabet9())
36. Call NewAlphabet(Alphabet9(), Alphabet10())
37. Call NewAlphabet(Alphabet10(), Alphabet11())
38. Call NewAlphabet(Alphabet11(), Alphabet12())
39. Call NewAlphabet(Alphabet12(), Alphabet13())
40.  
41. '''
42. Dim TheString As String
43.  
44. Dim As Integer j, k
45. Dim As Double f, g
46. Dim predictedGuess As Integer
47. Dim correctGuesses As Double
48. Dim totalGuesses As Double
49. Dim streakGuess As Integer
50. Dim streakBest As Integer
51.  
52. Dim ProgressGraph(1 To _Width) As Double
53.  
54. '''
55. ' Systematic cases:
56. '''
57. '                                                                                                                                         Score / Ending
58. '                                                                                                                                                 Streak:
59. '                                                                                                                                         ---------------
60. 'TheString = "111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111" ' (100% / 119)
61. 'TheString = "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000" ' (100% / 119)
62. 'TheString = "010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101" ' (96%  / 112)
63. 'TheString = "101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010" ' (96%  / 112)
64. 'TheString = "001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001" ' (96%  / 108)
65. 'TheString = "010010010010010010010010010010010010010010010010010010010010010010010010010010010010010010010010010010010010010010010010" ' (96%  / 109)
66. 'TheString = "100100100100100100100100100100100100100100100100100100100100100100100100100100100100100100100100100100100100100100100100" ' (93%  / 108)
67. 'TheString = "110110110110110110110110110110110110110110110110110110110110110110110110110110110110110110110110110110110110110110110110" ' (96%  / 108)
68. 'TheString = "101101101101101101101101101101101101101101101101101101101101101101101101101101101101101101101101101101101101101101101101" ' (96%  / 109)
69. 'TheString = "011011011011011011011011011011011011011011011011011011011011011011011011011011011011011011011011011011011011011011011011" ' (93%  / 108)
70. '
71. '''
72. ' Community hand-typed cases:
73. '''
74. '            (from Cobalt) (Results in: 48%  -  Claims he made this data hand but behavior in Discord raises doubt.)
75. 'TheString = "1010001101110110000000011100110100101010111110101001100101110100000111101011011000010101101100000110010010010101010110111111111001000100101011101000011110011000000100111100001100111000111100100000000111010011010011001111101000010011101111000011100011010110101101000111101111100101100100000101111011001101100000111011000001001111000110000001110101100101"
76. '            (from Loudar) (Results in: 71%)
77. 'TheString = "1011001010010100100100110010101010101001010101010101011010010101001010101001010010100110101011010101010101011010101101010101010101010010110101010101100101010101010110101101011010010101010010100110101101001010110101011010010101101010110100101111010101010011011011010010110101010010110100101101010100101011010010101001010101010001011101011010010101011100111010010001101011110010011010001011100110101010010011010101001001010010000101010110001"
78. '            (from Luke) (Results in: 51%  -  I have long suspected Luke to be a computer. The numbers are now in.)
79. 'TheString = "01100101001010001100001101101111011010010101010110110101001000001111001111110101000101111011010101111101010101101010101001010101011000010101010101001011010100110100110100110011010101010101110101010111111101011010100000001101111000010111000110111001000010100001101010110100000111101011111100001011001010110010110" ' Luke 50
80. '            (from Sarafromct) (Results in: 64%)
81. 'TheString = "10101010101011101000011101010111010101010101100111001010100111100001011011110101000001111010101101010000001111110011111110111101110111001110110010000100010101010101010100101011010110101010101010101001000000001111110000011110101010101010100010101110101010101101111111111111111111101010101010101000000" ' 63
82. '            (from Spriggs) (Results in: 85%)
83. TheString = "10111010101010101010101001010101010101001010101001010101010101010101010101010101010101010101010101010101001010100100100101010101010101001010100101010101010100101010100101010101010101010101001010010110010101010010101010101010101010101010100101001001001010101010101010101010101001010101001001101010010"
84. '            (from Spriggs) (Results in: 67%)
85. 'TheString = "11111011110100101011111111110100000011011110101100111100111111110111101110100111100110011111110101111111010111101111100111110111111111111011100111110111111110010000101011111001110101101010110111110"
86. '            (from Hotpants) (Results in: 62%)
87. 'TheString = "01010100011001010010101010101010101000110101010111101010100100011010101010100100101110010010010100001010101001010101010110010001001011000100100110101001001001010000000001010101101111101001010100010101001001010101000100101001100100010011010101010101010111010010101011101011011010110100100010010100100100010010001001" ' Tom
88. '
89. '''
90. ' Known-Random cases:
91. '''
92. '            (using RND) (Results in: 45%)
93. 'TheString = "11100101110011011010110100110011111011010110100100000110000100101001001010011100111101101110000001000000011011100101110000000111100100011101000000101000110100001000000001111010101011000010001110111110001001110101011000010101001111010100100000011100110110110000111010001010000011010000101111101011000"
94. '            (from Spriggs) (Results in: 52%)
95. 'TheString = "010101111010111100110000001001100100101100000101110001100101000010001001111101111111111100011110000011011110011000100011100100001101110011001001011001000011110010001000111100011100011110010110011110111010110100001000110000010000111000111011100110011010101111111100100010001111111100010100001011000011"
96. '            (Wolfrm rule 30, central column) (Results in: 47%)
97. 'TheString = "110111001100010110010011101011100111010101100001100101011010101111110000111100010101110000010010110001"
98. '            (using RND) (Results in: 46%)
99. 'TheString = "111001011100110110101101001100111110110101101001000001100001001010010010100111001111011011100000010000000110111001011100000001111001000111010000001010001101000010000000011110101010110000100011101111100010011101010110000101010011110101001000000111001101101100001110100010100000110100001011111010110000"
100. '            (using RND) (Results in: 46%)
101. 'TheString = "111001011100110110101101001100111110110101101001000001100001001010010010100111001111011011100000010000000110111001011100000001111001000111010000001010001101000010000000011110101010110000100011101111100010011101010110000101010011110101001000000111001101101100001110100010100000110100001011111010110000101110111110011100001000110010010001100111101000001101011000010101101011111010010001010010110110011000001001101000011100000011110001110011100010101010111101100100100001001000101101110110101100001111011101000100111110000001110000111011101000110110100111101101001100100110000111110111101001100010011110"
102. '            (using RND) (Results in: 45%)
103. 'TheString = "111001011100110110101101001100111110110101101001000001100001001010010010100111001111011011100000010000000110111001011100000001111001000111010000001010001101000010000000011110101010110000100011101111100010011101010110000101010011110101001000000111001101101100001110100010100000110100001011111010110000101110111110011100001000110010010001100111101000001101011000010101101011111010010001010010110110011000001001101000011100000011110001110011100010101010111101100100100001001000101101110110101100001111011101000100111110000001110000111011101000110110100111101101001100100110000111110111101001100010011110111001001100111000110011011000100101100010101010000010000111111010111111011100011100001000011000100100111001100001111010001010000001011100000101110000110010111110010101010110111110011100100001011101010000011011110110100010110111000100000110000001001010001011010000010001111110100100010011100011001000"
104. '            (using RND) (Results in: 48%)
105. 'TheString = "111001011100110110101101001100111110110101101001000001100001001010010010100111001111011011100000010000000110111001011100000001111001000111010000001010001101000010000000011110101010110000100011101111100010011101010110000101010011110101001000000111001101101100001110100010100000110100001011111010110000101110111110011100001000110010010001100111101000001101011000010101101011111010010001010010110110011000001001101000011100000011110001110011100010101010111101100100100001001000101101110110101100001111011101000100111110000001110000111011101000110110100111101101001100100110000111110111101001100010011110111001001100111000110011011000100101100010101010000010000111111010111111011100011100001000011000100100111001100001111010001010000001011100000101110000110010111110010101010110111110011100100001011101010000011011110110100010110111000100000110000001001010001011010000010001111110100100010011100011001000011101011010100110110000110010010011110111001001011111011000000100010011011100111110111011111101100011011101001111110100011010000111001001010111011101000001010010010100111010001001010101001000010011100111010101000110010110101111001110000010110110010101001000011000101000001100110100111101000110111101101010011011000101100101001010001100110101000101110000101100110010011010001010101010101101110101110110101100101001111100110110101011001000001100101001011000101100001001000001010111010100010100101011001111001011011100011001110010111011110010111101011101000100100010111010000001010011101010001110110110101011000101010100000001110110101011110101111100100101101000001011000101001110010010010000111001101010100101111101001110010001011000001001000111010001000011000111000000111001110111110011110110101100111011001100101101010101100010100100001010010110010000001100110010010100110011110110000001001000111001001010010000011111110011110010001100011100011010000111100111111010010001010011100100111100111101111110101000010011100011111100010000011111101101010010100000011011001110001100001011111100111000001110111011001111110011011100111000110110110011110000111000010011011000011001111111110010100000111110011111100100001100000000110001111101101011100011111011110001100100001100011100011111000000110011011100110101101001001111101101000000110101101001100011100011001110001000000111111100110101001110100010010010100000010100001010001011011001101010011111001101110110010101000111101100111000011000111001100011011011010100111111001100000100100110000100101001111111100110010111100000111101101001111001010011010011011100101001001001110101110001101010001111010101100101010111000111000011000001010010010101010100001110010001001001110110011100110011111001100111010011110100100110010000100011010001110000000100001100000010000111000111111000111100010001101011000101000010100011100011111000100010101000001001011001000101101111110111110110001101001001011100011110001101100010100101101011001001100111000000111111110110100010111111101000000001111000100001111111011000101001111110010000110101100010000011100110111101011011100110"
106.  
107.  
108.  
109.  
110. 'Cls
111. 'Locate 1, 1
112. 'Print " Press 0 or 1 as randomly as you can. The longer the string, the better."
113. 'Input "", TheString
114.  
115.  
116.  
117.  
118.  
119. For j = 1 To Len(TheString)
120.  
121.     Cls
122.     Locate 1, 1
123.     For k = 1 To _Width
124.         Print "_";
125.     Next
126.     Print
127.     Print "Analyzing: (string length "; _Trim$(Str$(Len(TheString))); ")"
128.     Print
129.     Color 7
130.     Print Left$(TheString, j);
131.     Color 8
132.     Print "["; Right$(TheString, Len(TheString) - j); "]"
133.     Color 7
134.     Print
135.  
136.     ' Main prediction call
137.     predictedGuess = Analyze(Left$(TheString, j), 0)
138.  
139.     ' Reconciliation
140.     Print "Prediction: "; _Trim$(Str$(predictedGuess))
141.     If (j < Len(TheString)) Then
142.         Print "Actual:     "; _Trim$(Mid$(TheString, j + 1, 1))
143.         If (predictedGuess = Val(Mid$(TheString, j + 1, 1))) Then
144.             correctGuesses = correctGuesses + 1
145.             streakGuess = streakGuess + 1
146.             If (streakGuess > streakBest) Then streakBest = streakGuess
147.             Print "I am RIGHT this round."
148.         Else
149.             streakGuess = 0
150.             Print "I am WRONG this round."
151.         End If
152.         totalGuesses = totalGuesses + 1
153.     Else
154.         Print "Actual:     ?"
155.     End If
156.     Print
157.     Print "I'm on a "; _Trim$(Str$(streakGuess)); "-round winning streak."
158.     Print "My best streak has been "; _Trim$(Str$(streakBest)); "."
159.     Print "My correctness rate is "; _Trim$(Str$(Int(100 * correctGuesses / totalGuesses))); "% in "; _Trim$(Str$(totalGuesses)); " guesses."
160.     If (j = Len(TheString)) Then
161.         Print
162.         Print "Complete."
163.     End If
164.  
165.     ' Draw bottom graph
166.     If (1 = 1) Then
167.         For k = 1 To _Width
168.             Locate _Height - 5, k: Print "_"
169.             Locate _Height - 5 - Int(10), k: Print "_"
170.         Next
171.         Locate _Height - 5 + 1, 1: Print "0%"
172.         Locate _Height - 5 - Int(10) - 1, 1: Print "100%"
173.         f = (_Width - 1) / Int(Len(TheString))
174.         If (f > 1) Then f = 1 / f
175.         ProgressGraph(1 + Int(j * f)) = correctGuesses / totalGuesses
176.         g = (_Width - 0) / Int(Len(TheString))
177.         If (g > 1) Then g = 1
178.         For k = 1 To Int(j * g)
179.             Locate _Height - 5 - Int(10 * ProgressGraph(1 + Int(k * f))), k: Print "*"
180.         Next
181.     End If
182.  
183.     _Delay .015
184.     _Display
185. Next
186.  
187. End
188.  
189. Function Analyze (TheStringIn As String, pswitch As Integer)
190.     Dim TheReturn As Integer
191.     Dim As Integer n
192.     Dim As Double r, j, k, h
193.     Dim Fingerprint(16) As String
194.     Dim Partialguess(1 To 10, 2) As Double ' Change the upper bound to a higer number for more accuracy.
195.  
196.     ' Create shifted versions of string, i.e. ABCD -> BCDA, CDAB, DABC, ABCD, BCDA, etc.
197.     Fingerprint(1) = TheStringIn
198.     For n = 2 To UBound(Fingerprint)
199.         Fingerprint(n) = Right$(Fingerprint(n - 1), Len(Fingerprint(n - 1)) - 1) + Left$(Fingerprint(n - 1), 1)
200.     Next
201.  
202.     ' Initialize partial results.
203.     For n = LBound(Partialguess) To UBound(Partialguess)
204.         Partialguess(n, 1) = -999
205.     Next
206.  
207.     Call CreateHisto(Fingerprint(), Alphabet1(), 1)
208.     Call CreateHisto(Fingerprint(), Alphabet2(), 2)
209.     Call CreateHisto(Fingerprint(), Alphabet3(), 3)
210.     Call CreateHisto(Fingerprint(), Alphabet4(), 4)
211.     Call CreateHisto(Fingerprint(), Alphabet5(), 5)
212.     Call CreateHisto(Fingerprint(), Alphabet6(), 6)
213.     Call CreateHisto(Fingerprint(), Alphabet7(), 7)
214.     Call CreateHisto(Fingerprint(), Alphabet8(), 8)
215.     Call CreateHisto(Fingerprint(), Alphabet9(), 9)
216.     Call CreateHisto(Fingerprint(), Alphabet10(), 10)
217.     'Call CreateHisto(Fingerprint(), Alphabet11(), 11)
218.     'Call CreateHisto(Fingerprint(), Alphabet12(), 12)
219.     'Call CreateHisto(Fingerprint(), Alphabet13(), 13)
220.  
221.     If (pswitch = 1) Then
222.         For n = 1 To _Width
223.             Print "-";
224.         Next
225.         Print
226.     End If
227.  
228.     If (pswitch = 1) Then ' Set the last number >=1 to print stats for that histogram.
229.         If (Len(TheStringIn) >= 1) Then Call PrintHisto(Alphabet1(), 2)
230.         If (Len(TheStringIn) >= 2) Then Call PrintHisto(Alphabet2(), 3)
231.         If (Len(TheStringIn) >= 3) Then Call PrintHisto(Alphabet3(), 3)
232.         If (Len(TheStringIn) >= 4) Then Call PrintHisto(Alphabet4(), 0)
233.         If (Len(TheStringIn) >= 5) Then Call PrintHisto(Alphabet5(), 0)
234.         If (Len(TheStringIn) >= 6) Then Call PrintHisto(Alphabet6(), 0)
235.         If (Len(TheStringIn) >= 7) Then Call PrintHisto(Alphabet7(), 0)
236.         If (Len(TheStringIn) >= 8) Then Call PrintHisto(Alphabet8(), 0)
237.         If (Len(TheStringIn) >= 9) Then Call PrintHisto(Alphabet9(), 0)
238.         If (Len(TheStringIn) >= 10) Then Call PrintHisto(Alphabet10(), 0)
239.         'If (Len(TheStringIn) >= 11) Then Call PrintHisto(Alphabet11(), 0)
240.         'If (Len(TheStringIn) >= 12) Then Call PrintHisto(Alphabet12(), 0)
241.         'If (Len(TheStringIn) >= 13) Then Call PrintHisto(Alphabet13(), 0)
242.         Print
243.     End If
244.  
245.     If (Len(TheStringIn) >= 1) Then Call MakeGuess(TheStringIn, Alphabet1(), 1, Partialguess(), pswitch)
246.     If (Len(TheStringIn) >= 2) Then Call MakeGuess(TheStringIn, Alphabet2(), 2, Partialguess(), pswitch) ' Set the last number =1 to print guess for that histogram.
247.     If (Len(TheStringIn) >= 3) Then Call MakeGuess(TheStringIn, Alphabet3(), 3, Partialguess(), pswitch)
248.     If (Len(TheStringIn) >= 4) Then Call MakeGuess(TheStringIn, Alphabet4(), 4, Partialguess(), 0)
249.     If (Len(TheStringIn) >= 5) Then Call MakeGuess(TheStringIn, Alphabet5(), 5, Partialguess(), 0)
250.     If (Len(TheStringIn) >= 6) Then Call MakeGuess(TheStringIn, Alphabet6(), 6, Partialguess(), 0)
251.     If (Len(TheStringIn) >= 7) Then Call MakeGuess(TheStringIn, Alphabet7(), 7, Partialguess(), 0)
252.     If (Len(TheStringIn) >= 8) Then Call MakeGuess(TheStringIn, Alphabet8(), 8, Partialguess(), 0)
253.     If (Len(TheStringIn) >= 9) Then Call MakeGuess(TheStringIn, Alphabet9(), 9, Partialguess(), 0)
254.     If (Len(TheStringIn) >= 10) Then Call MakeGuess(TheStringIn, Alphabet10(), 10, Partialguess(), 0)
255.     'If (Len(TheStringIn) >= 11) Then Call MakeGuess(TheStringIn, Alphabet11(), 11, Partialguess(), 0)
256.     'If (Len(TheStringIn) >= 12) Then Call MakeGuess(TheStringIn, Alphabet12(), 12, Partialguess(), 0)
257.     'If (Len(TheStringIn) >= 13) Then Call MakeGuess(TheStringIn, Alphabet13(), 13, Partialguess(), 0)
258.     If (pswitch = 1) Then Print
259.  
260.     If (pswitch = 1) Then
261.         Print "Thinking:";
262.         For k = LBound(Partialguess) To UBound(Partialguess)
263.             If (Partialguess(k, 1) <> -999) Then
264.                 Print Partialguess(k, 1);
265.             Else
266.                 Print "_ ";
267.             End If
268.         Next
269.         Print
270.     End If
271.  
272.     j = 0
273.     r = 0
274.  
275.     For k = UBound(Partialguess) To LBound(Partialguess) Step -1
276.         If (Partialguess(k, 1) <> -999) Then
277.  
278.             ' This is the made-up part of the model:
279.             ' The variable r contributes to weighted average.
280.             ' The variable j is used for normalization.
281.             ' Scaling factor h influences weighted average calculaton.
282.             ' The factors multiplying h are totally arbitrary. Notes:
283.             '   setting o(h^2) means the later alphabets count for more.
284.             '   Partialguess(k, 1) euqals the calculated guess at frequency k.
285.             '   Partialguess(k, 2) euqals the peak count of the unscaled histogram.
286.             '   ...while Partialguess(k, 2) is here, it does not seem to help calculations.
287.  
288.             h = 1 + k - LBound(Partialguess)
289.  
290.             h = h ^ 2
291.  
292.             ' Standard weighted average:
293.             r = r + h * Partialguess(k, 1)
294.             j = j + h
295.  
296.         End If
297.     Next
298.     If (j <> 0) Then
299.         r = r / j
300.     End If
301.  
302.     If (pswitch = 1) Then Print "Predicting:  "; _Trim$(Str$(r))
303.  
304.     If (r > .5) Then
305.         r = 1
306.     Else
307.         r = 0
308.     End If
309.  
310.     If (pswitch = 1) Then
311.         Print "Rounding to: "; _Trim$(Str$(r))
312.     End If
313.  
314.     If (pswitch = 1) Then
315.         For n = 1 To _Width
316.             Print "-";
317.         Next
318.         Print: Print
319.     End If
320.  
321.     TheReturn = r
322.     Analyze = TheReturn
323. End Function
324.  
325. Sub MakeGuess (TheStringIn As String, arralpha() As LetterBin, wid As Integer, arrbeta() As Double, pswitch As Integer)
326.     Dim TheReturn As Double
327.     Dim As Integer j, k, n
328.     TheReturn = 0
329.     j = 1 '0
330.     k = 0
331.     For n = 1 To UBound(arralpha)
332.         If (Left$(arralpha(n).Signature, wid - 1) = Right$(TheStringIn, wid - 1)) Then
333.             If (arralpha(n).Count >= j) Then
334.                 If (pswitch = 1) Then Print "Order-"; Right$("0" + _Trim$(Str$(wid)), 2); " guess: "; arralpha(n).Signature; " . "; _Trim$(Str$(arralpha(n).Count))
335.                 TheReturn = TheReturn + Val(Right$(arralpha(n).Signature, 1))
336.                 k = k + 1
337.                 j = arralpha(n).Count
338.             End If
339.         End If
340.     Next
341.     If (k <> 0) Then
342.         TheReturn = TheReturn / k
343.         arrbeta(wid, 1) = TheReturn
344.         arrbeta(wid, 2) = j
345.     Else
346.         TheReturn = .5
347.         arrbeta(wid, 1) = TheReturn
348.         arrbeta(wid, 2) = j
349.     End If
350. End Sub
351.  
352. Sub CreateHisto (arrfinger() As String, arralpha() As LetterBin, w As Integer)
353.     Dim As Integer j, k, n
354.     For n = 1 To UBound(arralpha)
355.         arralpha(n).Count = 0
356.     Next
357.     For j = 1 To w
358.         For k = 1 To Len(arrfinger(j)) - (Len(arrfinger(j)) Mod w) Step w '- 0 Step 1 'w 'make the 0 a -w? might not matter at all
359.             For n = 1 To UBound(arralpha)
360.                 If (Mid$(arrfinger(j), k, w) = arralpha(n).Signature) Then
361.                     arralpha(n).Count = arralpha(n).Count + 1
362.                 End If
363.             Next
364.         Next
365.     Next
366.     Call QuickSort(arralpha(), 1, UBound(arralpha))
367. End Sub
368.  
369. Sub PrintHisto (arr() As LetterBin, w As Integer)
370.     Dim As Integer j, n
371.     If (w > 0) Then
372.         If (w > UBound(arr)) Then
373.             j = UBound(arr)
374.         Else
375.             j = w
376.         End If
377.         Print "Histogram: "; _Trim$(Str$(UBound(arr))); "-letter regroup, showing top "; _Trim$(Str$(w))
378.         For n = 1 To j
379.             Print arr(n).Signature; arr(n).Count
380.         Next
381.     End If
382. End Sub
383.  
384. Sub NewAlphabet (arrold() As LetterBin, arrnew() As LetterBin)
385.     Dim As Integer j, k, n
386.     n = 0
387.     For k = 1 To 2
388.         For j = 1 To UBound(arrold)
389.             n = n + 1
390.             arrnew(n).Signature = arrold(j).Signature
391.         Next
392.     Next
393.     For j = 1 To UBound(arrnew)
394.         If (j <= UBound(arrnew) / 2) Then
395.             arrnew(j).Signature = "0" + arrnew(j).Signature
396.         Else
397.             arrnew(j).Signature = "1" + arrnew(j).Signature
398.         End If
399.     Next
400. End Sub
401.  
402. Sub QuickSort (arr() As LetterBin, LowLimit As Long, HighLimit As Long)
403.     Dim As Long piv
404.     If (LowLimit < HighLimit) Then
405.         piv = Partition(arr(), LowLimit, HighLimit)
406.         Call QuickSort(arr(), LowLimit, piv - 1)
407.         Call QuickSort(arr(), piv + 1, HighLimit)
408.     End If
409. End Sub
410.  
411. Function Partition (arr() As LetterBin, LowLimit As Long, HighLimit As Long)
412.     Dim As Long i, j
413.     Dim As Double pivot, tmp
414.     pivot = arr(HighLimit).Count
415.     i = LowLimit - 1
416.     For j = LowLimit To HighLimit - 1
417.         tmp = arr(j).Count - pivot
418.         If (tmp >= 0) Then
419.             i = i + 1
420.             Swap arr(i), arr(j)
421.         End If
422.     Next
423.     Swap arr(i + 1), arr(HighLimit)
424.     Partition = i + 1
425. End Function
426.  

Looks like this now while running:

  [ You are not allowed to view this attachment ]  

[random1]

If it gets any better the possibilities will expand exponentially.  I think it's has already
surpassed my expectations but more is better. 

Your quickly becoming my best new friend, LOL.  Can't wait for future improvements.

R1

[random1]

I am going to add stats for each prediction be it a 0 or 1.  This way I can track the
percentages of correct predictions for each value.

Also in my main program, if a string contains all 0's or all 1's then it skips the predictor
stage and uses the digit that makes up the entire string as the prediction.  Nothing to be
gained by processing a string if there's only one choice.

I have ran several strings that I consider the hardest to predict and while the overall is
lower, high 60's to low 70's, the streaks seem to increase in size. 

R1     


     

[STxAxTIC]

Hey r1,

I have made such a weird discovery, I don't even know its implications yet, but follow me for a minute.

* Suppose I have a string that starts just as a "1". To be definite, call this x$. So x$ = "1".
* Next I feed this through the analyzer, and the analyzer tells me that another "1" is most likely to come next. Ok, so at this stage, lets do the *opposite*.
* Append x$ with a "0", having predicted a 1. So x$ = "10" now.
* Feed this new x$ through the analyzer, and it predicts a "1" should follow the "10". But we're doing the opposite, so I append x$ = "100".

See what I'm doing? Start with a seed, and whatever the predictor says, make a string that's the opposite of whats predicted. The result is hilarious. You wind up with a thing I'll call a "pathological string", where all predictions are WRONG by definition. Look at this result!

  [ You are not allowed to view this attachment ]  

It's flat zeros! Don't do any fretting though, we're out on impossible limb. For real data to behave this way randomly would take longer than the age of the universe. Or, put another way, some system that feeds you such data would be indistinguishable, in that moment, from the program you're looking at now. (Weird.) It turns out I can generate probably infinite of these "pathological strings". But it gets even more interesting. Change even a single digit, such as the first digit, and everything downstream of that shatters like glass, and its back to a usual-looking pattern. Here is the same sequence minus the first character:

  [ You are not allowed to view this attachment ]  

Even though the entire string is meant to "trick" the analyzer, the entire string needs to be intact for the trick to happen. That's super interesting. There is nothing fundamental about the so-called pathological string, I mean in terms of their contents. They are strictly dependent on the model being used, and that is buried in my Analyze function. Their existence will always persist though, regardless of the model. There's got to be some kind of theorem about this... Anyway, thought you'd find this academically interesting. Has very little bearing on the task at hand, but here are what some more patholgical strings look like:

Code: QB64: [Select]

1.     '''
2.     ' Pathological cases:
3.     '''
4.     n = n + 1: TestData(n) = "011111101111111110101111110011111110110111110111011110111001110111010110111101001111101010111110010111100110111011010110" ' seed 0
5.     n = n + 1: TestData(n) = "100000010000000001010000001100000001001000001000100001000110001000101001000010110000010101000001101000011001000100101001" ' seed 1
6.     n = n + 1: TestData(n) = "001111111110111111101011111100111110111011110110111110101011110111100110111111000111111110010111110011101110101101110010" ' seed 00
7.     n = n + 1: TestData(n) = "011111101111111110101111110011111110110111110111011110111001110111010110111101001111101010111110010111100110111011010110" ' seed 01
8.     n = n + 1: TestData(n) = "100000010000000001010000001100000001001000001000100001000110001000101001000010110000010101000001101000011001000100101001" ' seed 10
9.     n = n + 1: TestData(n) = "110000000001000000010100000011000001000100001001000001010100001000011001000000111000000001101000001100010001010010001101" ' seed 11
10.     n = n + 1: TestData(n) = "000111111111011111101101111101011111110011111110101011101110110110101110011101111011101010011110110011111011110011011110" ' seed 000
11.     n = n + 1: TestData(n) = "001111111110111111101011111100111110111011110110111110101011110111100110111111000111111110010111110011101110101101110010" ' seed 001
12.     n = n + 1: TestData(n) = "010111111111011111101101111101011110111011110101011111100111111110010111110111001110111110001111110100111110101101110100" ' seed 010
13.     n = n + 1: TestData(n) = "011111101111111110101111110011111110110111110111011110111001110111010110111101001111101010111110010111100110111011010110" ' seed 011
14.     n = n + 1: TestData(n) = "100000010000000001010000001100000001001000001000100001000110001000101001000010110000010101000001101000011001000100101001" ' seed 100
15.     n = n + 1: TestData(n) = "101000000000100000010010000010100001000100001010100000011000000001101000001000110001000001110000001011000001010010001011" ' seed 101

And those are sensitive - change one thing and the graph explodes like you're taking apart a wristwatch. Full code below:

Code: QB64: [Select]

1. Option _Explicit
2.  
3. Screen _NewImage(120, 40)
4.  
5. ' Version: 14
6.  
7. Type LetterBin
8.     Signature As String
9.     Count As Integer
10. End Type
11.  
12. Dim Shared Alphabet1(2) As LetterBin ' 0 1
13. Dim Shared Alphabet2(4) As LetterBin ' 00 01 10 11
14. Dim Shared Alphabet3(8) As LetterBin ' 000 001 010 011 100 101 110 111
15. Dim Shared Alphabet4(16) As LetterBin ' etc.
16. Dim Shared Alphabet5(32) As LetterBin
17. Dim Shared Alphabet6(64) As LetterBin
18. Dim Shared Alphabet7(128) As LetterBin
19. Dim Shared Alphabet8(256) As LetterBin
20. Dim Shared Alphabet9(512) As LetterBin
21. Dim Shared Alphabet10(1024) As LetterBin
22. Dim Shared Alphabet11(2048) As LetterBin
23. Dim Shared Alphabet12(4096) As LetterBin
24. Dim Shared Alphabet13(8192) As LetterBin
25.  
26. Alphabet1(1).Signature = "0"
27. Alphabet1(2).Signature = "1"
28. Call NewAlphabet(Alphabet1(), Alphabet2())
29. Call NewAlphabet(Alphabet2(), Alphabet3())
30. Call NewAlphabet(Alphabet3(), Alphabet4())
31. Call NewAlphabet(Alphabet4(), Alphabet5())
32. Call NewAlphabet(Alphabet5(), Alphabet6())
33. Call NewAlphabet(Alphabet6(), Alphabet7())
34. Call NewAlphabet(Alphabet7(), Alphabet8())
35. Call NewAlphabet(Alphabet8(), Alphabet9())
36. Call NewAlphabet(Alphabet9(), Alphabet10())
37. Call NewAlphabet(Alphabet10(), Alphabet11())
38. Call NewAlphabet(Alphabet11(), Alphabet12())
39. Call NewAlphabet(Alphabet12(), Alphabet13())
40.  
41. '''
42.  
43. ReDim Shared TestData(1000) As String
44. ReDim _Preserve TestData(LoadTestData(0))
45.  
46. Dim TheString As String
47.  
48. Dim As Integer j, k, n
49. Dim As Double f, g
50. Dim GuessPredicted As Integer
51. Dim GuessesCorrect As Double
52. Dim GuessesTotal As Double
53. Dim GuessStreak As Integer
54. Dim GuessStreakBest As Integer
55.  
56. Dim ProgressGraph(1 To _Width, 2) As Double
57.  
58.  
59. For n = 1 To UBound(TestData)
60.  
61.     TheString = TestData(n)
62.     GuessesCorrect = 0
63.     GuessesTotal = 0
64.     GuessStreak = 0
65.     GuessStreakBest = 0
66.  
67.     ' Uncomment this to manually test one string.
68.     '''
69.     '1
70.     TheString = "00000010000000001010000001100000001001000001000100001000110001000101001000010110000010101000001101000011001000100101001"
71.  
72.     '''
73.     'Cls: Locate 1, 1
74.     'Input "", TheString
75.     '''
76.  
77.     For j = 1 To Len(TheString)
78.  
79.         Cls
80.         Locate 1, 1
81.         For k = 1 To _Width
82.             Print "_";
83.         Next
84.         Print
85.         Print "Analyzing: (test string # "; _Trim$(Str$(n)); ", length "; _Trim$(Str$(Len(TheString))); ")"
86.         Print
87.         Color 7
88.         Print Left$(TheString, j);
89.         Color 8
90.         Print "["; Right$(TheString, Len(TheString) - j); "]"
91.         Color 7
92.         Print
93.  
94.         ' Main prediction call
95.         GuessPredicted = Analyze(Left$(TheString, j), 0)
96.  
97.         ' Reconciliation
98.         Print "Prediction: "; _Trim$(Str$(GuessPredicted))
99.         If (j < Len(TheString)) Then
100.             Print "Actual:     "; _Trim$(Mid$(TheString, j + 1, 1))
101.             If (GuessPredicted = Val(Mid$(TheString, j + 1, 1))) Then
102.                 GuessesCorrect = GuessesCorrect + 1
103.                 GuessStreak = GuessStreak + 1
104.                 If (GuessStreak > GuessStreakBest) Then GuessStreakBest = GuessStreak
105.                 Print "I am RIGHT this round."
106.             Else
107.                 GuessStreak = 0
108.                 Print "I am WRONG this round."
109.             End If
110.             GuessesTotal = GuessesTotal + 1
111.         Else
112.             Print "Actual:     ?"
113.         End If
114.         Print
115.         Print "I'm on a "; _Trim$(Str$(GuessStreak)); "-round winning streak."
116.         Print "My best streak has been "; _Trim$(Str$(GuessStreakBest)); "."
117.         Print "My correctness rate is "; _Trim$(Str$(Int(100 * GuessesCorrect / GuessesTotal))); "% in "; _Trim$(Str$(GuessesTotal)); " guesses."
118.         If (j = Len(TheString)) Then
119.             Print
120.             Print "Complete."
121.         End If
122.  
123.         ' Draw bottom graph
124.         If (1 = 1) Then
125.             For k = 1 To _Width
126.                 Locate _Height - 5, k: Print "_"
127.                 Locate _Height - 5 - Int(10), k: Print "_"
128.             Next
129.             Locate _Height - 5 + 1, 1: Print "0%"
130.             Locate _Height - 5 - Int(10) - 1, 1: Print "100%"
131.             f = (_Width - 1) / Int(Len(TheString))
132.             If (f > 1) Then f = 1 / f
133.             ProgressGraph(1 + Int(j * f), 1) = GuessesCorrect / GuessesTotal
134.             If (GuessStreak = 0) Then
135.                 ProgressGraph(1 + Int(j * f), 2) = 120
136.             Else
137.                 ProgressGraph(1 + Int(j * f), 2) = 251
138.             End If
139.             g = (_Width - 0) / Int(Len(TheString))
140.             If (g > 1) Then g = 1
141.             For k = 1 To Int(j * g)
142.                 Locate _Height - 5 - Int(10 * ProgressGraph(1 + Int(k * f), 1)), k: Print Chr$(ProgressGraph(1 + Int(k * f), 2))
143.             Next
144.         End If
145.  
146.         _Delay .015
147.         _Display
148.     Next
149.  
150.     _Delay 3
151.  
152. Next
153.  
154. End
155.  
156. Function Analyze (TheStringIn As String, pswitch As Integer)
157.     Dim TheReturn As Integer
158.     Dim As Integer n
159.     Dim As Double r, j, k, h
160.     Dim Fingerprint(16) As String
161.     Dim Partialguess(1 To 10, 2) As Double ' Change the upper bound to a higer number for more accuracy.
162.  
163.     ' Create shifted versions of string, i.e. ABCD -> BCDA, CDAB, DABC, ABCD, BCDA, etc.
164.     Fingerprint(1) = TheStringIn
165.     For n = 2 To UBound(Fingerprint)
166.         Fingerprint(n) = Right$(Fingerprint(n - 1), Len(Fingerprint(n - 1)) - 1) + Left$(Fingerprint(n - 1), 1)
167.     Next
168.  
169.     ' Initialize partial results.
170.     For n = LBound(Partialguess) To UBound(Partialguess)
171.         Partialguess(n, 1) = -999
172.     Next
173.  
174.     Call CreateHisto(Fingerprint(), Alphabet1(), 1)
175.     Call CreateHisto(Fingerprint(), Alphabet2(), 2)
176.     Call CreateHisto(Fingerprint(), Alphabet3(), 3)
177.     Call CreateHisto(Fingerprint(), Alphabet4(), 4)
178.     Call CreateHisto(Fingerprint(), Alphabet5(), 5)
179.     Call CreateHisto(Fingerprint(), Alphabet6(), 6)
180.     Call CreateHisto(Fingerprint(), Alphabet7(), 7)
181.     Call CreateHisto(Fingerprint(), Alphabet8(), 8)
182.     Call CreateHisto(Fingerprint(), Alphabet9(), 9)
183.     Call CreateHisto(Fingerprint(), Alphabet10(), 10)
184.     'Call CreateHisto(Fingerprint(), Alphabet11(), 11)
185.     'Call CreateHisto(Fingerprint(), Alphabet12(), 12)
186.     'Call CreateHisto(Fingerprint(), Alphabet13(), 13)
187.  
188.     If (pswitch = 1) Then
189.         For n = 1 To _Width
190.             Print "-";
191.         Next
192.         Print
193.     End If
194.  
195.     If (pswitch = 1) Then ' Set the last number >=1 to print stats for that histogram.
196.         If (Len(TheStringIn) >= 1) Then Call PrintHisto(Alphabet1(), 2)
197.         If (Len(TheStringIn) >= 2) Then Call PrintHisto(Alphabet2(), 3)
198.         If (Len(TheStringIn) >= 3) Then Call PrintHisto(Alphabet3(), 3)
199.         If (Len(TheStringIn) >= 4) Then Call PrintHisto(Alphabet4(), 0)
200.         If (Len(TheStringIn) >= 5) Then Call PrintHisto(Alphabet5(), 0)
201.         If (Len(TheStringIn) >= 6) Then Call PrintHisto(Alphabet6(), 0)
202.         If (Len(TheStringIn) >= 7) Then Call PrintHisto(Alphabet7(), 0)
203.         If (Len(TheStringIn) >= 8) Then Call PrintHisto(Alphabet8(), 0)
204.         If (Len(TheStringIn) >= 9) Then Call PrintHisto(Alphabet9(), 0)
205.         If (Len(TheStringIn) >= 10) Then Call PrintHisto(Alphabet10(), 0)
206.         'If (Len(TheStringIn) >= 11) Then Call PrintHisto(Alphabet11(), 0)
207.         'If (Len(TheStringIn) >= 12) Then Call PrintHisto(Alphabet12(), 0)
208.         'If (Len(TheStringIn) >= 13) Then Call PrintHisto(Alphabet13(), 0)
209.         Print
210.     End If
211.  
212.     If (Len(TheStringIn) >= 1) Then Call MakeGuess(TheStringIn, Alphabet1(), 1, Partialguess(), pswitch) ' Set the last number =1 to print guess for that histogram.
213.     If (Len(TheStringIn) >= 2) Then Call MakeGuess(TheStringIn, Alphabet2(), 2, Partialguess(), pswitch)
214.     If (Len(TheStringIn) >= 3) Then Call MakeGuess(TheStringIn, Alphabet3(), 3, Partialguess(), pswitch)
215.     If (Len(TheStringIn) >= 4) Then Call MakeGuess(TheStringIn, Alphabet4(), 4, Partialguess(), 0)
216.     If (Len(TheStringIn) >= 5) Then Call MakeGuess(TheStringIn, Alphabet5(), 5, Partialguess(), 0)
217.     If (Len(TheStringIn) >= 6) Then Call MakeGuess(TheStringIn, Alphabet6(), 6, Partialguess(), 0)
218.     If (Len(TheStringIn) >= 7) Then Call MakeGuess(TheStringIn, Alphabet7(), 7, Partialguess(), 0)
219.     If (Len(TheStringIn) >= 8) Then Call MakeGuess(TheStringIn, Alphabet8(), 8, Partialguess(), 0)
220.     If (Len(TheStringIn) >= 9) Then Call MakeGuess(TheStringIn, Alphabet9(), 9, Partialguess(), 0)
221.     If (Len(TheStringIn) >= 10) Then Call MakeGuess(TheStringIn, Alphabet10(), 10, Partialguess(), 0)
222.     'If (Len(TheStringIn) >= 11) Then Call MakeGuess(TheStringIn, Alphabet11(), 11, Partialguess(), 0)
223.     'If (Len(TheStringIn) >= 12) Then Call MakeGuess(TheStringIn, Alphabet12(), 12, Partialguess(), 0)
224.     'If (Len(TheStringIn) >= 13) Then Call MakeGuess(TheStringIn, Alphabet13(), 13, Partialguess(), 0)
225.     If (pswitch = 1) Then Print
226.  
227.     If (pswitch = 1) Then
228.         Print "Thinking:";
229.         For k = LBound(Partialguess) To UBound(Partialguess)
230.             If (Partialguess(k, 1) <> -999) Then
231.                 Print Partialguess(k, 1);
232.             Else
233.                 Print "_ ";
234.             End If
235.         Next
236.         Print
237.     End If
238.  
239.     j = 0
240.     r = 0
241.  
242.     For k = UBound(Partialguess) To LBound(Partialguess) Step -1
243.         If (Partialguess(k, 1) <> -999) Then
244.  
245.             ' This is the made-up part of the model:
246.             ' The variable r contributes to weighted average.
247.             ' The variable j is used for normalization.
248.             ' Scaling factor h influences weighted average calculaton.
249.             ' The factors multiplying h are totally arbitrary. Notes:
250.             '   setting o(h^2) means the later alphabets count for more.
251.             '   Partialguess(k, 1) euqals the calculated guess at frequency k.
252.             '   Partialguess(k, 2) euqals the peak count of the unscaled histogram.
253.             '   ...while Partialguess(k, 2) is here, it does not seem to help calculations.
254.  
255.             h = 1 + k - LBound(Partialguess)
256.  
257.             h = h ^ 2
258.  
259.             ' Standard weighted average:
260.             r = r + h * Partialguess(k, 1)
261.             j = j + h
262.  
263.         End If
264.     Next
265.     If (j <> 0) Then
266.         r = r / j
267.     End If
268.  
269.     If (pswitch = 1) Then Print "Predicting:  "; _Trim$(Str$(r))
270.  
271.     If (r > .5) Then
272.         r = 1
273.     Else
274.         r = 0
275.     End If
276.  
277.     If (pswitch = 1) Then
278.         Print "Rounding to: "; _Trim$(Str$(r))
279.     End If
280.  
281.     If (pswitch = 1) Then
282.         For n = 1 To _Width
283.             Print "-";
284.         Next
285.         Print: Print
286.     End If
287.  
288.     TheReturn = r
289.     Analyze = TheReturn
290. End Function
291.  
292. Sub MakeGuess (TheStringIn As String, arralpha() As LetterBin, wid As Integer, arrbeta() As Double, pswitch As Integer)
293.     Dim TheReturn As Double
294.     Dim As Integer j, k, n
295.     TheReturn = 0
296.     j = 1
297.     k = 0
298.     For n = 1 To UBound(arralpha)
299.         If (Left$(arralpha(n).Signature, wid - 1) = Right$(TheStringIn, wid - 1)) Then
300.             If (arralpha(n).Count >= j) Then
301.                 If (pswitch = 1) Then Print "Order-"; Right$("0" + _Trim$(Str$(wid)), 2); " guess: "; arralpha(n).Signature; " . "; _Trim$(Str$(arralpha(n).Count))
302.                 TheReturn = TheReturn + Val(Right$(arralpha(n).Signature, 1))
303.                 k = k + 1
304.                 j = arralpha(n).Count
305.             End If
306.         End If
307.     Next
308.     If (k <> 0) Then
309.         TheReturn = TheReturn / k
310.         arrbeta(wid, 1) = TheReturn
311.         arrbeta(wid, 2) = j
312.     Else
313.         TheReturn = .5
314.         arrbeta(wid, 1) = TheReturn
315.         arrbeta(wid, 2) = j
316.     End If
317. End Sub
318.  
319. Sub CreateHisto (arrfinger() As String, arralpha() As LetterBin, w As Integer)
320.     Dim As Integer j, k, n
321.     For n = 1 To UBound(arralpha)
322.         arralpha(n).Count = 0
323.     Next
324.     For j = 1 To w
325.         For k = 1 To Len(arrfinger(j)) - (Len(arrfinger(j)) Mod w) Step w '- 0 Step 1 'w 'make the 0 a -w? might not matter at all
326.             For n = 1 To UBound(arralpha)
327.                 If (Mid$(arrfinger(j), k, w) = arralpha(n).Signature) Then
328.                     arralpha(n).Count = arralpha(n).Count + 1
329.                 End If
330.             Next
331.         Next
332.     Next
333.     Call QuickSort(arralpha(), 1, UBound(arralpha))
334. End Sub
335.  
336. Sub PrintHisto (arr() As LetterBin, w As Integer)
337.     Dim As Integer j, n
338.     If (w > 0) Then
339.         If (w > UBound(arr)) Then
340.             j = UBound(arr)
341.         Else
342.             j = w
343.         End If
344.         Print "Histogram: "; _Trim$(Str$(UBound(arr))); "-letter regroup, showing top "; _Trim$(Str$(w))
345.         For n = 1 To j
346.             Print arr(n).Signature; arr(n).Count
347.         Next
348.     End If
349. End Sub
350.  
351. Sub NewAlphabet (arrold() As LetterBin, arrnew() As LetterBin)
352.     Dim As Integer j, k, n
353.     n = 0
354.     For k = 1 To 2
355.         For j = 1 To UBound(arrold)
356.             n = n + 1
357.             arrnew(n).Signature = arrold(j).Signature
358.         Next
359.     Next
360.     For j = 1 To UBound(arrnew)
361.         If (j <= UBound(arrnew) / 2) Then
362.             arrnew(j).Signature = "0" + arrnew(j).Signature
363.         Else
364.             arrnew(j).Signature = "1" + arrnew(j).Signature
365.         End If
366.     Next
367. End Sub
368.  
369. Sub QuickSort (arr() As LetterBin, LowLimit As Long, HighLimit As Long)
370.     Dim As Long piv
371.     If (LowLimit < HighLimit) Then
372.         piv = Partition(arr(), LowLimit, HighLimit)
373.         Call QuickSort(arr(), LowLimit, piv - 1)
374.         Call QuickSort(arr(), piv + 1, HighLimit)
375.     End If
376. End Sub
377.  
378. Function Partition (arr() As LetterBin, LowLimit As Long, HighLimit As Long)
379.     Dim As Long i, j
380.     Dim As Double pivot, tmp
381.     pivot = arr(HighLimit).Count
382.     i = LowLimit - 1
383.     For j = LowLimit To HighLimit - 1
384.         tmp = arr(j).Count - pivot
385.         If (tmp >= 0) Then
386.             i = i + 1
387.             Swap arr(i), arr(j)
388.         End If
389.     Next
390.     Swap arr(i + 1), arr(HighLimit)
391.     Partition = i + 1
392. End Function
393.  
394. Function LoadTestData (alwayszero As Integer)
395.     Dim n As Integer
396.     n = alwayszero
397.     '''
398.     ' Systematic cases:
399.     '''
400.     n = n + 1: TestData(n) = "1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111"
401.     n = n + 1: TestData(n) = "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
402.     n = n + 1: TestData(n) = "0101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101"
403.     n = n + 1: TestData(n) = "1010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010"
404.     n = n + 1: TestData(n) = "0010010010010010010010010010010010010010010010010010010010010010010010010010010010010010010010010010010010010010010010010010010010010010010010010010010010010010"
405.     n = n + 1: TestData(n) = "0100100100100100100100100100100100100100100100100100100100100100100100100100100100100100100100100100100100100100100100100100100100100100100100100100100100100100"
406.     n = n + 1: TestData(n) = "1001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001"
407.     n = n + 1: TestData(n) = "1101101101101101101101101101101101101101101101101101101101101101101101101101101101101101101101101101101101101101101101101101101101101101101101101101101101101101"
408.     n = n + 1: TestData(n) = "1011011011011011011011011011011011011011011011011011011011011011011011011011011011011011011011011011011011011011011011011011011011011011011011011011011011011011"
409.     n = n + 1: TestData(n) = "0110110110110110110110110110110110110110110110110110110110110110110110110110110110110110110110110110110110110110110110110110110110110110110110110110110110110110"
410.     '
411.     '''
412.     ' Community hand-typed cases:
413.     '''
414.     ' (from Cobalt) (Results in: 48%  -  Claims he made this data hand but behavior in Discord raises doubt.)
415.     n = n + 1: TestData(n) = "1010001101110110000000011100110100101010111110101001100101110100000111101011011000010101101100000110010010010101010110111111111001000100101011101000011110011000000100111100001100111000111100100000000111010011010011001111101000010011101111000011100011010110101101000111101111100101100100000101111011001101100000111011000001001111000110000001110101100101"
416.     ' (from Keybone) (Results in: 82%)
417.     n = n + 1: TestData(n) = "101010101010101010101001010101010101001010111001010101010101010101010100010101010101010100101001010101001100101010001010100101010100101010100101010101010101010011011110010101010100100101010110010011001010011001010100010100101010010101010101010010101010101010010101001010101010100110010101010100101010101010011001001010100101010010101010100101010010101001010100101001010010101010111010100110011001010101010100110101001010101010100101001010111010101010101010100101001010101010010101010101001010101001010101001010100101010100101010010101010101001010101001010101010101001010101001010100101010101010010101010010010101010101010101010010100101010101001010100101001010101001111101010101010100101010110011001010101010101010110101010101101010101010100101010010101010010101010101101110010101001010101010110010100101010101001011010101010100110101010100101010010101010100101010101001010101010101001010101010011010101010101110110100101010111010101011011001011001010101001010101010101010101010011001010101010100101010101010101010010100101"
418.     ' (from Keybone) (Results in: 54%)
419.     n = n + 1: TestData(n) = "0101110101100011010100101011001110001011001010001110101111010100111011100100101001010011110101101000101010001010101111001010111010101010100001010101000101101100101111101010010101110110111001000101000011010101010001001001001111101011101010100010110101110101100000101010101110111010100100100001110111100101011110101010001010001110010110111110110010101001001011101000101001011100011101000010101010101101010010110100101101000101111010101110111001010011101111010101000010101111100010101011110101011011110100001010110"
420.     ' (from Loudar) (Results in: 71%)
421.     n = n + 1: TestData(n) = "1011001010010100100100110010101010101001010101010101011010010101001010101001010010100110101011010101010101011010101101010101010101010010110101010101100101010101010110101101011010010101010010100110101101001010110101011010010101101010110100101111010101010011011011010010110101010010110100101101010100101011010010101001010101010001011101011010010101011100111010010001101011110010011010001011100110101010010011010101001001010010000101010110001"
422.     ' (from Luke) (Results in: 51%  -  I have long suspected Luke to be a computer. The numbers are now in.)
423.     n = n + 1: TestData(n) = "01100101001010001100001101101111011010010101010110110101001000001111001111110101000101111011010101111101010101101010101001010101011000010101010101001011010100110100110100110011010101010101110101010111111101011010100000001101111000010111000110111001000010100001101010110100000111101011111100001011001010110010110" ' Luke 50
424.     ' (from Sarafromct) (Results in: 64%)
425.     n = n + 1: TestData(n) = "10101010101011101000011101010111010101010101100111001010100111100001011011110101000001111010101101010000001111110011111110111101110111001110110010000100010101010101010100101011010110101010101010101001000000001111110000011110101010101010100010101110101010101101111111111111111111101010101010101000000" ' 63
426.     ' (from Spriggs) (Results in: 85%)
427.     n = n + 1: TestData(n) = "10111010101010101010101001010101010101001010101001010101010101010101010101010101010101010101010101010101001010100100100101010101010101001010100101010101010100101010100101010101010101010101001010010110010101010010101010101010101010101010100101001001001010101010101010101010101001010101001001101010010"
428.     ' (from Spriggs) (Results in: 67%)
429.     n = n + 1: TestData(n) = "11111011110100101011111111110100000011011110101100111100111111110111101110100111100110011111110101111111010111101111100111110111111111111011100111110111111110010000101011111001110101101010110111110"
430.     ' (from Hotpants) (Results in: 62%)
431.     n = n + 1: TestData(n) = "01010100011001010010101010101010101000110101010111101010100100011010101010100100101110010010010100001010101001010101010110010001001011000100100110101001001001010000000001010101101111101001010100010101001001010101000100101001100100010011010101010101010111010010101011101011011010110100100010010100100100010010001001" ' Tom
432.     '
433.     '''
434.     ' Known-Random cases:
435.     '''
436.     ' (using RND) (Results in: 45%)
437.     n = n + 1: TestData(n) = "11100101110011011010110100110011111011010110100100000110000100101001001010011100111101101110000001000000011011100101110000000111100100011101000000101000110100001000000001111010101011000010001110111110001001110101011000010101001111010100100000011100110110110000111010001010000011010000101111101011000"
438.     ' (from Spriggs) (Results in: 52%)
439.     n = n + 1: TestData(n) = "010101111010111100110000001001100100101100000101110001100101000010001001111101111111111100011110000011011110011000100011100100001101110011001001011001000011110010001000111100011100011110010110011110111010110100001000110000010000111000111011100110011010101111111100100010001111111100010100001011000011"
440.     ' (Wolfrm rule 30, central column) (Results in: 47%)
441.     n = n + 1: TestData(n) = "110111001100010110010011101011100111010101100001100101011010101111110000111100010101110000010010110001"
442.     ' (using RND) (Results in: 46%)
443.     n = n + 1: TestData(n) = "111001011100110110101101001100111110110101101001000001100001001010010010100111001111011011100000010000000110111001011100000001111001000111010000001010001101000010000000011110101010110000100011101111100010011101010110000101010011110101001000000111001101101100001110100010100000110100001011111010110000"
444.     ' (using RND) (Results in: 46%)
445.     n = n + 1: TestData(n) = "111001011100110110101101001100111110110101101001000001100001001010010010100111001111011011100000010000000110111001011100000001111001000111010000001010001101000010000000011110101010110000100011101111100010011101010110000101010011110101001000000111001101101100001110100010100000110100001011111010110000101110111110011100001000110010010001100111101000001101011000010101101011111010010001010010110110011000001001101000011100000011110001110011100010101010111101100100100001001000101101110110101100001111011101000100111110000001110000111011101000110110100111101101001100100110000111110111101001100010011110"
446.     ' (using RND) (Results in: 45%)
447.     n = n + 1: TestData(n) = "111001011100110110101101001100111110110101101001000001100001001010010010100111001111011011100000010000000110111001011100000001111001000111010000001010001101000010000000011110101010110000100011101111100010011101010110000101010011110101001000000111001101101100001110100010100000110100001011111010110000101110111110011100001000110010010001100111101000001101011000010101101011111010010001010010110110011000001001101000011100000011110001110011100010101010111101100100100001001000101101110110101100001111011101000100111110000001110000111011101000110110100111101101001100100110000111110111101001100010011110111001001100111000110011011000100101100010101010000010000111111010111111011100011100001000011000100100111001100001111010001010000001011100000101110000110010111110010101010110111110011100100001011101010000011011110110100010110111000100000110000001001010001011010000010001111110100100010011100011001000"
448.     ' (using RND) (Results in: 48%)
449.     n = n + 1: TestData(n) = "111001011100110110101101001100111110110101101001000001100001001010010010100111001111011011100000010000000110111001011100000001111001000111010000001010001101000010000000011110101010110000100011101111100010011101010110000101010011110101001000000111001101101100001110100010100000110100001011111010110000101110111110011100001000110010010001100111101000001101011000010101101011111010010001010010110110011000001001101000011100000011110001110011100010101010111101100100100001001000101101110110101100001111011101000100111110000001110000111011101000110110100111101101001100100110000111110111101001100010011110111001001100111000110011011000100101100010101010000010000111111010111111011100011100001000011000100100111001100001111010001010000001011100000101110000110010111110010101010110111110011100100001011101010000011011110110100010110111000100000110000001001010001011010000010001111110100100010011100011001000011101011010100110110000110010010011110111001001011111011000000100010011011100111110111011111101100011011101001111110100011010000111001001010111011101000001010010010100111010001001010101001000010011100111010101000110010110101111001110000010110110010101001000011000101000001100110100111101000110111101101010011011000101100101001010001100110101000101110000101100110010011010001010101010101101110101110110101100101001111100110110101011001000001100101001011000101100001001000001010111010100010100101011001111001011011100011001110010111011110010111101011101000100100010111010000001010011101010001110110110101011000101010100000001110110101011110101111100100101101000001011000101001110010010010000111001101010100101111101001110010001011000001001000111010001000011000111000000111001110111110011110110101100111011001100101101010101100010100100001010010110010000001100110010010100110011110110000001001000111001001010010000011111110011110010001100011100011010000111100111111010010001010011100100111100111101111110101000010011100011111100010000011111101101010010100000011011001110001100001011111100111000001110111011001111110011011100111000110110110011110000111000010011011000011001111111110010100000111110011111100100001100000000110001111101101011100011111011110001100100001100011100011111000000110011011100110101101001001111101101000000110101101001100011100011001110001000000111111100110101001110100010010010100000010100001010001011011001101010011111001101110110010101000111101100111000011000111001100011011011010100111111001100000100100110000100101001111111100110010111100000111101101001111001010011010011011100101001001001110101110001101010001111010101100101010111000111000011000001010010010101010100001110010001001001110110011100110011111001100111010011110100100110010000100011010001110000000100001100000010000111000111111000111100010001101011000101000010100011100011111000100010101000001001011001000101101111110111110110001101001001011100011110001101100010100101101011001001100111000000111111110110100010111111101000000001111000100001111111011000101001111110010000110101100010000011100110111101011011100110"
450.     '
451.     '''
452.     ' Pathological cases:
453.     '''
454.     n = n + 1: TestData(n) = "011111101111111110101111110011111110110111110111011110111001110111010110111101001111101010111110010111100110111011010110" ' seed 0
455.     n = n + 1: TestData(n) = "100000010000000001010000001100000001001000001000100001000110001000101001000010110000010101000001101000011001000100101001" ' seed 1
456.     n = n + 1: TestData(n) = "001111111110111111101011111100111110111011110110111110101011110111100110111111000111111110010111110011101110101101110010" ' seed 00
457.     n = n + 1: TestData(n) = "011111101111111110101111110011111110110111110111011110111001110111010110111101001111101010111110010111100110111011010110" ' seed 01
458.     n = n + 1: TestData(n) = "100000010000000001010000001100000001001000001000100001000110001000101001000010110000010101000001101000011001000100101001" ' seed 10
459.     n = n + 1: TestData(n) = "110000000001000000010100000011000001000100001001000001010100001000011001000000111000000001101000001100010001010010001101" ' seed 11
460.     n = n + 1: TestData(n) = "000111111111011111101101111101011111110011111110101011101110110110101110011101111011101010011110110011111011110011011110" ' seed 000
461.     n = n + 1: TestData(n) = "001111111110111111101011111100111110111011110110111110101011110111100110111111000111111110010111110011101110101101110010" ' seed 001
462.     n = n + 1: TestData(n) = "010111111111011111101101111101011110111011110101011111100111111110010111110111001110111110001111110100111110101101110100" ' seed 010
463.     n = n + 1: TestData(n) = "011111101111111110101111110011111110110111110111011110111001110111010110111101001111101010111110010111100110111011010110" ' seed 011
464.     n = n + 1: TestData(n) = "100000010000000001010000001100000001001000001000100001000110001000101001000010110000010101000001101000011001000100101001" ' seed 100
465.     n = n + 1: TestData(n) = "101000000000100000010010000010100001000100001010100000011000000001101000001000110001000001110000001011000001010010001011" ' seed 101
466.  
467.     LoadTestData = n
468. End Function
469.  
470. ''''''''''
471. ' Code for creating pathological strings:
472. 'Dim x$
473. 'Dim q
474. 'x$ = "101"
475. 'Print x$;
476. 'Do
477. '    Cls
478. '    Locate 1, 1
479. '    q = Analyze(x$, 0)
480. '    If (q = 1) Then
481. '        x$ = x$ + "0"
482. '    Else
483. '        x$ = x$ + "1"
484. '    End If
485. '    Print x$
486. '    _Display
487. '    _Delay .015
488. '    _Limit 120
489. 'Loop Until Len(x$) = 120
490. 'Open "nnn.txt" For Output As #1
491. 'Print #1, x$
492. 'Close #1
493. ''''''''''

[random1]

STxAxTIC

I haven't tested but one string in this manner but the 1 to 0 prediction ratio is 1 in 17.52.
The predictor predicted (0) 473 times vs only 27 (1's) in a string of 500 entries. 

I then looked at the full string of 1422 entries and it shows the overall counts are 916 zeros
vs 506 ones.  This gives us a ratio of 1 in 2.81 for the full string. 

The full string shows (0) makes up 64.4% of the data while (1) makes up 35.5%.  Next I will
test the number predicted (1) guesses to see how many of those were correct.

We might need to step back and reevaluate a few things.

R1

 
     

[STxAxTIC]

Deep breath r1,

The eval core hasn't changed in quite a while, and when it does, all of my metrics improve. Can you paste in a string you find "interesting" so I can do my own analysis?

[random1]

STxAxTIC

Here is the string I am using, it's a update of a earlier posted string. Difficultly rating = 7
 
00101000111101101011000010000100001100110110100001100001100000000010011001000101000010001000000111011100000100000000010111010110000000010001110010110111000001011010111100101101010000011101110011010000110010011101011111000001000011001000000010011110011000000010101010011100100000010100010010111100100100100001000010011001101101001101110100011001100000010100000010001000010110100010100011000010001010101011110000000000110000011001000000100001110000100100010000001110000010100000101010100010001101000010

I can provide the full length strings if needed, I will place them in a .bas file so word wrap is not a problem, let me know.

I added counters to show the counts for the number of 0's and the number of 1's the predictor makes.
I also counted the number of correct guesses for each.

Results
The predictor predicted a zero 473 times, of those it correctly predicted a (0) 299 times for  63.2%
The predictor predicted a one 27 times, of those it correctly predicted a (1) 13 times for 48.%1

My concerns center on the total number of 1's the predictor makes.  Some strings tested have a
greater number of 1's with hit rates running in the mid 40's. 

My primal thoughts on this is that maybe a small weight could be added to the ones column but this
might produce unwanted results.  I have a control panel that would allow me to tinker with weight
values, don't know if this would help or not. In past attempts I was able to tweak the results for
the better but not enough to make any real progress.  Like to know your thoughts.
 

R1

[STxAxTIC]

Morning R1,

That string looks fine, I'll fix up some comments on it later.

(edit: deleted some crap i decided wasnt true)


Alright, so you raise another point about tweaking the model. This part is subtle, and is frankly the only "human decision" made throughout this entire code. Here's the heart:

Code: QB64: [Select]

1.     For k = UBound(Partialguess) To LBound(Partialguess) Step -1
2.         If (Partialguess(k, 1) <> -999) Then
3.  
4.             ' This is the made-up part of the model:
5.             ' The variable r contributes to weighted average.
6.             ' The variable j is used for normalization.
7.             ' Scaling factor h influences weighted average calculaton.
8.             ' The factors multiplying h are totally arbitrary. Notes:
9.             '   setting o(h^2) means the later alphabets count for more.
10.             '   Partialguess(k, 1) euqals the calculated guess at frequency k.
11.             '   Partialguess(k, 2) euqals the peak count of the unscaled histogram.
12.             '   ...while Partialguess(k, 2) is here, it does not seem to help calculations.
13.  
14.             h = 1 + k - LBound(Partialguess)
15.  
16.             h = h ^ 2
17.  
18.             ' Standard weighted average:
19.             r = r + h * Partialguess(k, 1)
20.             j = j + h
21.  
22.         End If
23.     Next
24.     If (j <> 0) Then
25.         r = r / j
26.     End If
27.  

All you need to pay attention to is the variable h. Right now, the model is set so that h is proportional to the library size we're using, and then I let h -> h^2 so that later, longer guesses count for more. If you want all partial guesses to count the same, let h=1. If you want early guesses to count for more, let h -> sqr(h) or something. I haven't changed this part in quite some time, so beware what you get! (There are probably even better models waiting to be discovered right here but I haven't really needed to yet...)


OH and I almost forgot. Want better accuracy? uncomment alphabets 11,12, and 13. It will look for deeper patterns in trade for a little speed.

[random1]

STxAxTIC

Un-commenting the alphabets should not present a speed issue on my end.  My mention of the
added weight is to introduce a user defined static value just before the final prediction is made.
Like I said I have a control panel already set up for this sort a thing.  However I would like to
wait until we think the predictor is fully developed before coding the CP into the main program. 
When the predictor is fully developed then it will run in sort of a silent mode so to say with just
a process bar to indicate the overall progress.  I will add the print switch to all the printed stuff
so that it can be blocked when it's no longer needed.

Attached is a picture of the predictors front end showing process bars,  Red is data gathering,
Green = formatting, blue = predictor process, larger pink bar to the right indicates overall
progress.  Picture shows a 10 string run.

Second picture shows the yet unfinished config menu.  This writes any user settings to a .ini file
which is then read just before the predictor is ran. 

R1       

[STxAxTIC]

Hey R1,

You mentioned plenty in the above, but I wanted to expound on this part a little:

My mention of the added weight is to introduce a user defined static value just before the final prediction is made. Like I said I have a control panel already set up for this sort a thing.

Throughout using this program, it occurred to me that my variable "h" explained above does not need to be a single value, but can be an array h() with one "weight" per value, much like you're talking about. The novel idea comes next: This array h() can actually be "trained" by the machine itself using whatever input strings we want, kindof exactly like a real AI project. So far all my code does is a big dumb deterministic calculation, but imagine if it tweaked its own model in order to maximize performance on the full suite of test strings? It's not even that difficult, the way I set things up.

I can't get to work on that yet though, because off to the side I'm trying to document all the progress we've made so far. This code doesn't speak well enough for itself, and certainly doesn't defend itself against... ahem... attacks... so I'm drafting a fake article on this as we speak. This will explain why I'm going to stop using the forum as a dev blog, too, haha.

Keep me posted with your updates, I like the screenshots too!

[random1]

STxAxTIC

I understand and agree.  If even what we have already discussed could be successfully implemented
then it might become very lucrative tool, don't blame you for going undercover so to say.   Please
stay in touch via private message if you have anything more to share.  As I've said I have been
working on this for years using different approaches but find my lack of skill in converting certain
math's into working code a problem.  As you probability already know, most mathematicians kind
of roll their eyes at something like this, some, not all.   

Many thanks for everything.

R1.

P.S.
My program makes a bunch of statistical calculations before the strings are ever presented to the
predictor.  I have not  implemented any of them yet as I need to first streamline your code so
that it integrates perfectly with the main program code.  I will add several controls to the config
menu like the string length, number of calls, weights, threshold, trigger etc... 

Again thanks for your post.             

[STxAxTIC]

Ah hey R1!

So maybe I wasn't a thousand percent clear in my post above - I'm not really going underground with this work as much as I'm getting out of everyone's hair with it. Since the whole idea here isn't so obvious, it deserves a proper explanation rather than just code and forum posts... So that means I'm putting the work elsewhere, namely here:

http://barnes.x10host.com/pages/Binary-Analyzer.php

It's barely a third of the way done as I sit here now, but within the next few days it should be fully drafted. I do this in notepad without spell check cause I'm a madlad, so this page is subject to corrections. Anyway, the full story is now going there ^

[random1]

STxAxTIC

The information in the link has already filled in several blanks I had in understanding your
code, stupid me.  I should be able to adapt it now so that it fits seamlessly into my existing
code.     

Big thumbs up on the link and I look forward to the finished project.  Maybe were on the same
page now.  I admit I've been a bit cryptic in my postings.         

Thanks 

R1