Author Topic: Looking for old program or help recreating it  (Read 9013 times)

0 Members and 1 Guest are viewing this topic.

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
Re: Looking for old program or help recreating it
« Reply #75 on: December 17, 2021, 11:01:56 pm »
Hey R1 -

I just wanted to let you know of yet another discovery that I made that speeds everything up by ... lemme think... O(len(S)), where S is the input sequence. Anyway, I finally got around to testing whether my full-blown "phase analysis" - which was necessary for projects similar to this one - was necessary for this problem. Turns out everything improves yet again if I leave the phase stuff out of my solution. What's this mean for the code? The array inside the Analyze function called Fingerprint can be completely commented out. TheString is just "The String" now. No need to create close copies. I'm going to leave that code in anyway (related problems need it to stay, details on request). The real speed change happens because of:

Code: QB64: [Select]
  1. Sub CreateHisto (arrfinger() As String, arralpha() As LetterBin, w As Integer)
  2.     Dim As Integer j, k, n
  3.     For n = 1 To UBound(arralpha)
  4.         arralpha(n).Count = 0
  5.     Next
  6.     'For j = 1 To w
  7.     j = 1
  8.     For k = 1 To Len(arrfinger(j)) - (Len(arrfinger(j)) Mod w) Step w
  9.         For n = 1 To UBound(arralpha)
  10.             If (Mid$(arrfinger(j), k, w) = arralpha(n).Signature) Then
  11.                 arralpha(n).Count = arralpha(n).Count + 1
  12.             End If
  13.         Next
  14.     Next
  15.     'Next
  16.     Call QuickSort(arralpha(), 1, UBound(arralpha))

See the entire FOR loop commented out? Good news. This all means j=1 for the whole sub, and the "fingerprint" array arrfinger() is really just a constant, just the working string. Doing this move improved every result by a little bit, and the whole thing runs faster. It's rare to find a win-win this late into the project!

I only found this because my write-up demanded that I talk about it. Since I don't want to delete a whole chapter, it's just "optional" now. I know you have the link, but for completeness:

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

... And of course, the full code as of now:

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

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
Re: Looking for old program or help recreating it
« Reply #76 on: December 19, 2021, 02:57:46 pm »
Hey R1

So the draft is finally complete, I can't believe it. I just updated the site with my hurried, probably typo-ridden discourse taking the reader through this project. I took care to explain every step, with pictures. Its subject to little updates for typos and stuff, but for the model described and the numbers shouldn't change.

As per usual, it's here: http://barnes.x10host.com/pages/Binary-Analyzer.php

The BAS file at the top is the latest version of the code (and always will be, consider that page the home for this code).

Now.... with all that out of the way.... I changed my "h" variable into an array, so I can turn certain weights on or off manually instead of using a sweeping function. This hasn't been explored whatsoever yet, but the code is ready to go on that front. The challenge now becomes stepping through "weight space", which, ironically can be reduced to a bunch of 1 and 0 switches, which it itself a binary sequence - and we could feed this into the ....!... nevermind... So I'll call this a milestone and let it rest a while.

Now I may inhale.
You're not done when it works, you're done when it's right.

Offline random1

  • Newbie
  • Posts: 86
Re: Looking for old program or help recreating it
« Reply #77 on: December 20, 2021, 01:29:55 am »
STxAxTIC

I would like to see a fully stripped down version of the code, ie, string in / prediction
out, no print code or commented out stuff.  I use the full update as a stand-alone to
to check the edits I make in my embedded code,  If both outputs match then I figure
there's no mistakes.  If it's not too much to ask, it would be great to have a stripped
version along with full updates. 

Thanks for all the content and work on your end.  I can't weight, "pun intended," to work
with the new version.  Too many arms in the fire right now but soon as the holidays end
I will be able to dig in.

R1   


Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
Re: Looking for old program or help recreating it
« Reply #78 on: December 20, 2021, 07:02:30 am »
Morning r1,

So there is a short answer to your question, and that's my function Analyze(). It's a black box that receives a string and returns a number. I got rid of the commented-out lines, but it still takes a print switch argument can be ignored by setting to 0 forever.

Things got a little more complicated, too. I removed from Analyze() all of the human-influenced parts of the prediction model, and put this information in a shared array called AlphaWeight(). There is a good reason for this you may see coming. Anyway, a call to Analyze() looks like this:

Code: QB64: [Select]
  1.  GuessPredicted = Analyze(TheString, AlphaWeight(), 0)

If you want the absolute black-box nugget of code that makes this go, that's the line. You can delete everything enclosing that line and use it in isolation. Admittedly I could/should streamline this function in terms of the way it *looks*, but that's a style issue I'll figure out later. It's me skirting around the arrays-in-types problem, if you want the excuse.

The reason AlphaWeight() is it's own entity now is I've discovered two different prediction models that work for two different jobs. For the long, wacky test strings we've been doing, the full-frequency analysis works best. For human inputs though, for some reason, 5-grams work the best: turn off all weights except 5. This is pure sorcery though, no good reason to have made this realization.

My next job is to come up with a way to "walk through weight space" where I can apply calculus to focus in on the best models for given tasks. Kinda exciting really. Sounds like AI (a term I hate).

As a program note, there are now three downloads at the top of the website. I froze the "article" version of the code in time so that there's something executable to go with the website. The main code is moving on though. (It's all kept straight with a version number.)

Code: QB64: [Select]
  1.  
  2. Screen _NewImage(120, 40)
  3.  
  4. ' Version: 18
  5.  
  6. Type LetterBin
  7.     Signature As String
  8.     Count As Integer
  9.  
  10. Dim Shared Alphabet1(2) As LetterBin ' 0 1
  11. Dim Shared Alphabet2(4) As LetterBin ' 00 01 10 11
  12. Dim Shared Alphabet3(8) As LetterBin ' 000 001 010 011 100 101 110 111
  13. Dim Shared Alphabet4(16) As LetterBin ' etc.
  14. Dim Shared Alphabet5(32) As LetterBin
  15. Dim Shared Alphabet6(64) As LetterBin
  16. Dim Shared Alphabet7(128) As LetterBin
  17. Dim Shared Alphabet8(256) As LetterBin
  18. Dim Shared Alphabet9(512) As LetterBin
  19. Dim Shared Alphabet10(1024) As LetterBin
  20. Dim Shared Alphabet11(2048) As LetterBin
  21. Dim Shared Alphabet12(4096) As LetterBin
  22. Dim Shared Alphabet13(8192) As LetterBin
  23.  
  24. Alphabet1(1).Signature = "0"
  25. Alphabet1(2).Signature = "1"
  26. Call NewAlphabet(Alphabet1(), Alphabet2())
  27. Call NewAlphabet(Alphabet2(), Alphabet3())
  28. Call NewAlphabet(Alphabet3(), Alphabet4())
  29. Call NewAlphabet(Alphabet4(), Alphabet5())
  30. Call NewAlphabet(Alphabet5(), Alphabet6())
  31. Call NewAlphabet(Alphabet6(), Alphabet7())
  32. Call NewAlphabet(Alphabet7(), Alphabet8())
  33. Call NewAlphabet(Alphabet8(), Alphabet9())
  34. Call NewAlphabet(Alphabet9(), Alphabet10())
  35. Call NewAlphabet(Alphabet10(), Alphabet11())
  36. Call NewAlphabet(Alphabet11(), Alphabet12())
  37. Call NewAlphabet(Alphabet12(), Alphabet13())
  38.  
  39. ' Load test data.
  40. ReDim Shared TestData(10000) As String
  41. ReDim _Preserve TestData(LoadTestData(0))
  42.  
  43. ' This is the made-up part of the model.
  44. Dim Shared AlphaWeight(13) As Double
  45.  
  46. ' Statistics and metrics:
  47. Dim GuessPredicted As Integer
  48. Dim GuessesCorrect As Double
  49. Dim GuessesTotal As Double
  50. Dim GuessStreak As Integer
  51. Dim GuessStreakMax As Integer
  52. Dim Grade(10000, 2) As Double
  53.  
  54. Call InitializeModel
  55.  
  56. '''
  57. ' Bypass pre-cooked test data.
  58. 'TestData(1) = "1111111111111111111111"
  59. 'ReDim _Preserve TestData(1)
  60. '''
  61.  
  62. Dim TheString As String
  63. Dim As Integer k, m, n
  64.  
  65. For m = 1 To UBound(TestData)
  66.  
  67.     GuessPredicted = -1
  68.     GuessesCorrect = 0
  69.     GuessesTotal = 0
  70.     GuessStreak = 0
  71.     GuessStreakMax = 0
  72.  
  73.     For n = 1 To Len(TestData(m))
  74.  
  75.         '''
  76.         ' Research Mode
  77.         TheString = Left$(TestData(m), n)
  78.         '''
  79.  
  80.         '''
  81.         '' Gaming Mode
  82.         'Cls
  83.         'Locate 1, 1
  84.         'Print "Press LEFT or RIGHT."
  85.         'k = 0
  86.         'Do: k = _KeyHit: Loop Until ((k = 19200) Or (k = 19712))
  87.         'Select Case k
  88.         '    Case 19200
  89.         '        TheString = TheString + "0"
  90.         '    Case 19712
  91.         '        TheString = TheString + "1"
  92.         'End Select
  93.         '_KeyClear
  94.         '''
  95.  
  96.         Cls
  97.         Color 7
  98.         Locate 1, 1
  99.         For k = 1 To _Width
  100.             Print "_";
  101.         Next
  102.         Print "Model:";
  103.         For k = 1 To UBound(AlphaWeight)
  104.             Print AlphaWeight(k);
  105.         Next
  106.         Print
  107.         Print
  108.         Print "Sequence (length "; _Trim$(Str$(Len(TheString))); "):"
  109.         Print TheString;
  110.         Color 8
  111.         Print Right$(TestData(m), Len(TestData(m)) - n)
  112.         Color 7
  113.  
  114.         ' Reconciliation
  115.         If (GuessPredicted <> -1) Then
  116.             Print
  117.             Print
  118.             Print "I predicted "; _Trim$(Str$(GuessPredicted)); " and you typed "; Right$(TheString, 1); "."
  119.             If (GuessPredicted = Val(Right$(TheString, 1))) Then
  120.                 Print "I am RIGHT this round."
  121.                 GuessesCorrect = GuessesCorrect + 1
  122.                 GuessStreak = GuessStreak + 1
  123.                 If (GuessStreak > GuessStreakMax) Then GuessStreakMax = GuessStreak
  124.                 Grade(n, 2) = 1
  125.             Else
  126.                 Print "I am WRONG this round."
  127.                 GuessStreak = 0
  128.                 Grade(n, 2) = 0
  129.             End If
  130.             GuessesTotal = GuessesTotal + 1
  131.             Grade(n, 1) = GuessesCorrect / GuessesTotal
  132.         End If
  133.  
  134.         If (GuessesTotal > 0) Then
  135.             Print
  136.             Print "I'm on a "; _Trim$(Str$(GuessStreak)); "-round winning streak."
  137.             Print "My best streak has been "; _Trim$(Str$(GuessStreakMax)); "."
  138.             If (GuessesTotal <> 0) Then
  139.                 Print "My correctness rate is "; _Trim$(Str$(Int(100 * GuessesCorrect / GuessesTotal))); "% in "; _Trim$(Str$(GuessesTotal)); " guesses."
  140.             End If
  141.         End If
  142.  
  143.         GuessPredicted = Analyze(TheString, AlphaWeight(), 0)
  144.  
  145.         Print
  146.         Print "I have made a prediction."
  147.         Print "Press LEFT or RIGHT to test me."
  148.  
  149.         ' Draw bottom graph
  150.         If (CsrLin <= 23) Then
  151.             If (GuessesTotal <> 0) Then
  152.                 Call PrintGraph(TheString, Grade())
  153.             End If
  154.         End If
  155.  
  156.         _Delay .02
  157.         _Display
  158.         _Limit 60
  159.     Next
  160.  
  161.     _Delay 3
  162.  
  163.  
  164. Sub InitializeModel
  165.     Dim As Integer k
  166.     For k = 1 To UBound(AlphaWeight)
  167.         AlphaWeight(k) = k ^ 2
  168.     Next
  169.     'AlphaWeight(1) = 0
  170.     'AlphaWeight(2) = 0
  171.     'AlphaWeight(3) = 0
  172.     'AlphaWeight(4) = 0
  173.     'AlphaWeight(5) = 1
  174.     'AlphaWeight(6) = 0
  175.     'AlphaWeight(7) = 0
  176.     'AlphaWeight(8) = 0
  177.     'AlphaWeight(9) = 0
  178.     'AlphaWeight(10) = 0
  179.     AlphaWeight(11) = 0
  180.     AlphaWeight(12) = 0
  181.     AlphaWeight(13) = 0
  182.  
  183. Function Analyze (TheStringIn As String, arrweight() As Double, pswitch As Integer)
  184.     Dim TheReturn As Integer
  185.     Dim As Integer n
  186.     Dim As Double r, j, k
  187.     Dim StringPhase(16) As String
  188.     Dim Partialguess(1 To 13, 2) As Double ' Change the upper bound to a higer number for more accuracy.
  189.  
  190.     ' Create shifted versions of string, i.e. ABCD -> BCDA, CDAB, DABC, ABCD, BCDA, etc.
  191.     StringPhase(1) = TheStringIn
  192.     'For n = 2 To UBound(StringPhase)
  193.     'StringPhase(n) = Right$(StringPhase(n - 1), Len(StringPhase(n - 1)) - 1) + Left$(StringPhase(n - 1), 1)
  194.     'Next
  195.  
  196.     ' Initialize partial results.
  197.     For n = LBound(Partialguess) To UBound(Partialguess)
  198.         Partialguess(n, 1) = -999
  199.     Next
  200.  
  201.     If (arrweight(1) <> 0) Then Call CreateHisto(StringPhase(), Alphabet1(), 1)
  202.     If (arrweight(2) <> 0) Then Call CreateHisto(StringPhase(), Alphabet2(), 2)
  203.     If (arrweight(3) <> 0) Then Call CreateHisto(StringPhase(), Alphabet3(), 3)
  204.     If (arrweight(4) <> 0) Then Call CreateHisto(StringPhase(), Alphabet4(), 4)
  205.     If (arrweight(5) <> 0) Then Call CreateHisto(StringPhase(), Alphabet5(), 5)
  206.     If (arrweight(6) <> 0) Then Call CreateHisto(StringPhase(), Alphabet6(), 6)
  207.     If (arrweight(7) <> 0) Then Call CreateHisto(StringPhase(), Alphabet7(), 7)
  208.     If (arrweight(8) <> 0) Then Call CreateHisto(StringPhase(), Alphabet8(), 8)
  209.     If (arrweight(9) <> 0) Then Call CreateHisto(StringPhase(), Alphabet9(), 9)
  210.     If (arrweight(10) <> 0) Then Call CreateHisto(StringPhase(), Alphabet10(), 10)
  211.     If (arrweight(11) <> 0) Then Call CreateHisto(StringPhase(), Alphabet11(), 11)
  212.     If (arrweight(12) <> 0) Then Call CreateHisto(StringPhase(), Alphabet12(), 12)
  213.     If (arrweight(13) <> 0) Then Call CreateHisto(StringPhase(), Alphabet13(), 13)
  214.  
  215.     If (pswitch = 1) Then
  216.         For n = 1 To _Width
  217.             Print "-";
  218.         Next
  219.         Print
  220.     End If
  221.  
  222.     If (pswitch = 1) Then ' Set the last argument >=1 to print stats for that histogram.
  223.         If ((Len(TheStringIn) >= 1) And (arrweight(1) <> 0)) Then Call PrintHisto(Alphabet1(), 2)
  224.         If ((Len(TheStringIn) >= 2) And (arrweight(2) <> 0)) Then Call PrintHisto(Alphabet2(), 4)
  225.         If ((Len(TheStringIn) >= 3) And (arrweight(3) <> 0)) Then Call PrintHisto(Alphabet3(), 4)
  226.         If ((Len(TheStringIn) >= 4) And (arrweight(4) <> 0)) Then Call PrintHisto(Alphabet4(), 0)
  227.         If ((Len(TheStringIn) >= 5) And (arrweight(5) <> 0)) Then Call PrintHisto(Alphabet5(), 0)
  228.         If ((Len(TheStringIn) >= 6) And (arrweight(6) <> 0)) Then Call PrintHisto(Alphabet6(), 0)
  229.         If ((Len(TheStringIn) >= 7) And (arrweight(7) <> 0)) Then Call PrintHisto(Alphabet7(), 0)
  230.         If ((Len(TheStringIn) >= 8) And (arrweight(8) <> 0)) Then Call PrintHisto(Alphabet8(), 0)
  231.         If ((Len(TheStringIn) >= 9) And (arrweight(9) <> 0)) Then Call PrintHisto(Alphabet9(), 0)
  232.         If ((Len(TheStringIn) >= 10) And (arrweight(10) <> 0)) Then Call PrintHisto(Alphabet10(), 0)
  233.         If ((Len(TheStringIn) >= 11) And (arrweight(11) <> 0)) Then Call PrintHisto(Alphabet11(), 0)
  234.         If ((Len(TheStringIn) >= 12) And (arrweight(12) <> 0)) Then Call PrintHisto(Alphabet12(), 0)
  235.         If ((Len(TheStringIn) >= 13) And (arrweight(13) <> 0)) Then Call PrintHisto(Alphabet13(), 0)
  236.         Print
  237.     End If
  238.  
  239.     If ((Len(TheStringIn) >= 1) And (arrweight(1) <> 0)) Then Call MakeGuess(TheStringIn, Alphabet1(), 1, Partialguess(), 0) ' Set the last argument =1 to print guess for that histogram.
  240.     If ((Len(TheStringIn) >= 2) And (arrweight(2) <> 0)) Then Call MakeGuess(TheStringIn, Alphabet2(), 2, Partialguess(), pswitch)
  241.     If ((Len(TheStringIn) >= 3) And (arrweight(3) <> 0)) Then Call MakeGuess(TheStringIn, Alphabet3(), 3, Partialguess(), pswitch)
  242.     If ((Len(TheStringIn) >= 4) And (arrweight(4) <> 0)) Then Call MakeGuess(TheStringIn, Alphabet4(), 4, Partialguess(), 0)
  243.     If ((Len(TheStringIn) >= 5) And (arrweight(5) <> 0)) Then Call MakeGuess(TheStringIn, Alphabet5(), 5, Partialguess(), 0)
  244.     If ((Len(TheStringIn) >= 6) And (arrweight(6) <> 0)) Then Call MakeGuess(TheStringIn, Alphabet6(), 6, Partialguess(), 0)
  245.     If ((Len(TheStringIn) >= 7) And (arrweight(7) <> 0)) Then Call MakeGuess(TheStringIn, Alphabet7(), 7, Partialguess(), 0)
  246.     If ((Len(TheStringIn) >= 8) And (arrweight(8) <> 0)) Then Call MakeGuess(TheStringIn, Alphabet8(), 8, Partialguess(), 0)
  247.     If ((Len(TheStringIn) >= 9) And (arrweight(9) <> 0)) Then Call MakeGuess(TheStringIn, Alphabet9(), 9, Partialguess(), 0)
  248.     If ((Len(TheStringIn) >= 10) And (arrweight(10) <> 0)) Then Call MakeGuess(TheStringIn, Alphabet10(), 10, Partialguess(), 0)
  249.     If ((Len(TheStringIn) >= 11) And (arrweight(11) <> 0)) Then Call MakeGuess(TheStringIn, Alphabet11(), 11, Partialguess(), 0)
  250.     If ((Len(TheStringIn) >= 12) And (arrweight(12) <> 0)) Then Call MakeGuess(TheStringIn, Alphabet12(), 12, Partialguess(), 0)
  251.     If ((Len(TheStringIn) >= 13) And (arrweight(13) <> 0)) Then Call MakeGuess(TheStringIn, Alphabet13(), 13, Partialguess(), 0)
  252.     If (pswitch = 1) Then Print
  253.  
  254.     If (pswitch = 1) Then
  255.         Print "Thinking:";
  256.         For k = LBound(Partialguess) To UBound(Partialguess)
  257.             If (Partialguess(k, 1) <> -999) Then
  258.                 Print Partialguess(k, 1);
  259.             Else
  260.                 Print "_ ";
  261.             End If
  262.         Next
  263.         Print
  264.     End If
  265.  
  266.     j = 0
  267.     r = 0
  268.  
  269.     For k = UBound(Partialguess) To LBound(Partialguess) Step -1
  270.         If (Partialguess(k, 1) <> -999) Then
  271.             ' weighted average:
  272.             r = r + arrweight(k) * Partialguess(k, 1)
  273.             j = j + arrweight(k)
  274.         End If
  275.     Next
  276.     If (j <> 0) Then
  277.         r = r / j
  278.     End If
  279.  
  280.     If (pswitch = 1) Then Print "Predicting:  "; _Trim$(Str$(r))
  281.  
  282.     If (r > .5) Then
  283.         r = 1
  284.     Else
  285.         r = 0
  286.     End If
  287.  
  288.     If (pswitch = 1) Then
  289.         Print "Rounding to: "; _Trim$(Str$(r))
  290.     End If
  291.  
  292.     If (pswitch = 1) Then
  293.         For n = 1 To _Width
  294.             Print "-";
  295.         Next
  296.         Print: Print
  297.     End If
  298.  
  299.     TheReturn = r
  300.     Analyze = TheReturn
  301.  
  302. Sub MakeGuess (TheStringIn As String, arralpha() As LetterBin, wid As Integer, arrbeta() As Double, pswitch As Integer)
  303.     Dim TheReturn As Double
  304.     Dim As Integer j, k, n
  305.     TheReturn = 0
  306.     j = 1
  307.     k = 0
  308.     For n = 1 To UBound(arralpha)
  309.         If (Left$(arralpha(n).Signature, wid - 1) = Right$(TheStringIn, wid - 1)) Then
  310.             If (arralpha(n).Count >= j) Then
  311.                 If (pswitch = 1) Then Print "Order-"; Right$("0" + _Trim$(Str$(wid)), 2); " guess: "; arralpha(n).Signature; " . "; _Trim$(Str$(arralpha(n).Count))
  312.                 TheReturn = TheReturn + Val(Right$(arralpha(n).Signature, 1))
  313.                 k = k + 1
  314.                 j = arralpha(n).Count
  315.             End If
  316.         End If
  317.     Next
  318.     If (k <> 0) Then
  319.         TheReturn = TheReturn / k
  320.     Else
  321.         TheReturn = .5
  322.     End If
  323.     arrbeta(wid, 1) = TheReturn
  324.     arrbeta(wid, 2) = j
  325.  
  326. Sub CreateHisto (arrfinger() As String, arralpha() As LetterBin, w As Integer)
  327.     Dim As Integer j, k, n
  328.     For n = 1 To UBound(arralpha)
  329.         arralpha(n).Count = 0
  330.     Next
  331.     'For j = 1 To w
  332.     j = 1
  333.     For k = 1 To Len(arrfinger(j)) - (Len(arrfinger(j)) Mod w) Step w
  334.         For n = 1 To UBound(arralpha)
  335.             If (Mid$(arrfinger(j), k, w) = arralpha(n).Signature) Then
  336.                 arralpha(n).Count = arralpha(n).Count + 1
  337.             End If
  338.         Next
  339.     Next
  340.     'Next
  341.     Call QuickSort(arralpha(), 1, UBound(arralpha))
  342.  
  343. Sub PrintHisto (arr() As LetterBin, w As Integer)
  344.     Dim As Integer j, n
  345.     If (w > 0) Then
  346.         If (w > UBound(arr)) Then
  347.             j = UBound(arr)
  348.         Else
  349.             j = w
  350.         End If
  351.         Print "Histogram: "; _Trim$(Str$(UBound(arr))); "-letter regroup, showing top "; _Trim$(Str$(w))
  352.         For n = 1 To j
  353.             Print arr(n).Signature; arr(n).Count
  354.         Next
  355.     End If
  356.  
  357. Sub PrintGraph (TheString As String, arrgrade() As Double)
  358.     Dim As Integer j, k
  359.     Dim As Double f, g, h
  360.     For k = 1 To _Width
  361.         Locate _Height - 5, k: Print "_"
  362.         Locate _Height - 5 - 10, k: Print "_"
  363.     Next
  364.     Locate _Height - 5 + 1, 1: Print "0%"
  365.     Locate _Height - 5 - 10 - 1, 1: Print "100%"
  366.     f = _Width / Len(TheString)
  367.     If (f > 1) Then f = 1
  368.     For j = 1 To Len(TheString)
  369.         h = j * f
  370.         If (h < 1) Then h = h + 1
  371.         g = arrgrade(j, 1)
  372.         Locate _Height - 5 - Int(10 * g), Int(h)
  373.         If (arrgrade(j, 2) = 1) Then
  374.             Print Chr$(251)
  375.         Else
  376.             Print "x"
  377.         End If
  378.     Next
  379.  
  380. Sub NewAlphabet (arrold() As LetterBin, arrnew() As LetterBin)
  381.     Dim As Integer j, k, n
  382.     n = 0
  383.     For k = 1 To 2
  384.         For j = 1 To UBound(arrold)
  385.             n = n + 1
  386.             arrnew(n).Signature = arrold(j).Signature
  387.         Next
  388.     Next
  389.     For j = 1 To UBound(arrnew)
  390.         If (j <= UBound(arrnew) / 2) Then
  391.             arrnew(j).Signature = "0" + arrnew(j).Signature
  392.         Else
  393.             arrnew(j).Signature = "1" + arrnew(j).Signature
  394.         End If
  395.     Next
  396.  
  397. Sub QuickSort (arr() As LetterBin, LowLimit As Long, HighLimit As Long)
  398.     Dim As Long piv
  399.     If (LowLimit < HighLimit) Then
  400.         piv = Partition(arr(), LowLimit, HighLimit)
  401.         Call QuickSort(arr(), LowLimit, piv - 1)
  402.         Call QuickSort(arr(), piv + 1, HighLimit)
  403.     End If
  404.  
  405. Function Partition (arr() As LetterBin, LowLimit As Long, HighLimit As Long)
  406.     Dim As Long i, j
  407.     Dim As Double pivot, tmp
  408.     pivot = arr(HighLimit).Count
  409.     i = LowLimit - 1
  410.     For j = LowLimit To HighLimit - 1
  411.         tmp = arr(j).Count - pivot
  412.         If (tmp >= 0) Then
  413.             i = i + 1
  414.             Swap arr(i), arr(j)
  415.         End If
  416.     Next
  417.     Swap arr(i + 1), arr(HighLimit)
  418.     Partition = i + 1
  419.  
  420. 'Function Pathological$ (TheSeed As String, TheLength As Integer)
  421. '    Dim TheReturn As String
  422. '    TheReturn = TheSeed
  423. '    Dim p
  424. '    Do
  425. '        Cls
  426. '        Locate 1, 1
  427. '        Print TheReturn;
  428. '        p = Analyze(TheReturn, 0)
  429. '        If (p = 1) Then
  430. '            TheReturn = TheReturn + "0"
  431. '        Else
  432. '            TheReturn = TheReturn + "1"
  433. '        End If
  434. '    Loop Until Len(TheReturn) = TheLength
  435. '    Pathological$ = TheReturn
  436. 'End Function
  437.  
  438. Function LoadTestData (alwayszero As Integer)
  439.     Dim n As Integer
  440.     n = alwayszero
  441.  
  442.     '''
  443.     ' Percussive cases:
  444.     '''
  445.     n = n + 1: TestData(n) = "1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111"
  446.     n = n + 1: TestData(n) = "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
  447.     n = n + 1: TestData(n) = "0101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101"
  448.     n = n + 1: TestData(n) = "1010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010"
  449.     n = n + 1: TestData(n) = "0001110011000111001100011100110001110011000111001100011100110001110011000111001100011100110001110011000111001100011100110001110011000111001100011100110001110011"
  450.     n = n + 1: TestData(n) = "0100010111010001011101000101110100010111010001011101000101110100010111010001011101000101110100010111010001011101000101110100010111010001011101000101110100010111"
  451.  
  452.     '''
  453.     ' Human samples:
  454.     '''
  455.     ' (from Keybone)
  456.     n = n + 1: TestData(n) = "101010101010101010101001010101010101001010111001010101010101010101010100010101010101010100101001010101001100101010001010100101010100101010100101010101010101010011011110010101010100100101010110010011001010011001010100010100101010010101010101010010101010101010010101001010101010100110010101010100101010101010011001001010100101010010101010100101010010101001010100101001010010101010111010100110011001010101010100110101001010101010100101001010111010101010101010100101001010101010010101010101001010101001010101001010100101010100101010010101010101001010101001010101010101001010101001010100101010101010010101010010010101010101010101010010100101010101001010100101001010101001111101010101010100101010110011001010101010101010110101010101101010101010100101010010101010010101010101101110010101001010101010110010100101010101001011010101010100110101010100101010010101010100101010101001010101010101001010101010011010101010101110110100101010111010101011011001011001010101001010101010101010101010011001010101010100101010101010101010010100101"
  457.     ' (from Keybone)
  458.     n = n + 1: TestData(n) = "0101110101100011010100101011001110001011001010001110101111010100111011100100101001010011110101101000101010001010101111001010111010101010100001010101000101101100101111101010010101110110111001000101000011010101010001001001001111101011101010100010110101110101100000101010101110111010100100100001110111100101011110101010001010001110010110111110110010101001001011101000101001011100011101000010101010101101010010110100101101000101111010101110111001010011101111010101000010101111100010101011110101011011110100001010110"
  459.     ' (from Loudar)
  460.     n = n + 1: TestData(n) = "1011001010010100100100110010101010101001010101010101011010010101001010101001010010100110101011010101010101011010101101010101010101010010110101010101100101010101010110101101011010010101010010100110101101001010110101011010010101101010110100101111010101010011011011010010110101010010110100101101010100101011010010101001010101010001011101011010010101011100111010010001101011110010011010001011100110101010010011010101001001010010000101010110001"
  461.     ' (from Luke)
  462.     n = n + 1: TestData(n) = "01100101001010001100001101101111011010010101010110110101001000001111001111110101000101111011010101111101010101101010101001010101011000010101010101001011010100110100110100110011010101010101110101010111111101011010100000001101111000010111000110111001000010100001101010110100000111101011111100001011001010110010110"
  463.     ' (from Sarafromct)
  464.     n = n + 1: TestData(n) = "10101010101011101000011101010111010101010101100111001010100111100001011011110101000001111010101101010000001111110011111110111101110111001110110010000100010101010101010100101011010110101010101010101001000000001111110000011110101010101010100010101110101010101101111111111111111111101010101010101000000"
  465.     ' (from Spriggs)
  466.     n = n + 1: TestData(n) = "10111010101010101010101001010101010101001010101001010101010101010101010101010101010101010101010101010101001010100100100101010101010101001010100101010101010100101010100101010101010101010101001010010110010101010010101010101010101010101010100101001001001010101010101010101010101001010101001001101010010"
  467.     ' (from Spriggs)
  468.     n = n + 1: TestData(n) = "11111011110100101011111111110100000011011110101100111100111111110111101110100111100110011111110101111111010111101111100111110111111111111011100111110111111110010000101011111001110101101010110111110"
  469.     ' (from Hotpants)
  470.     n = n + 1: TestData(n) = "01010100011001010010101010101010101000110101010111101010100100011010101010100100101110010010010100001010101001010101010110010001001011000100100110101001001001010000000001010101101111101001010100010101001001010101000100101001100100010011010101010101010111010010101011101011011010110100100010010100100100010010001001"
  471.  
  472.     LoadTestData = n
  473.  
« Last Edit: December 20, 2021, 07:14:00 am by STxAxTIC »
You're not done when it works, you're done when it's right.

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
Re: Looking for old program or help recreating it
« Reply #79 on: December 20, 2021, 02:04:07 pm »
Hey again R1,

I decided to just try oooooone more idea with this thing, and as fate would have it, that was like a dozen ideas ago. Before I get too crazy far ahead, I wanted to let you know that this program's prediction algo is now able to tune itself without any human intervention. That is to say, it does a kind of machine learning. Gulp. There goes another weekend probably... It seems to be doing very well so far - it's already found a better model than what the Inform game uses. (These updates are coming in hot.)

Just some review so we're on the same page. For a sequence S, the program looks at patterns in fixed width chunks 1,2,3,4...,7,8,9,10. That's why there are 10 alphabets, etc. etc. Alright, so this means the algorithm can come up with 10 different guesses g(n) for the result, one for each chunk size / library. The most general way to combine those looks like:

Prediction(s) = N * (w(1)*g(1) + w(2)*g(2) + w(3)*g(3) + ... + w(10)*g(10))

Where the function w(n) is the weight function we've been talking about. My old h-variable. So far so good?

Up til today, two such w(n)-models have been deployed:
(i) For our heavy testing, I let w(n) = n^2, so high-alphabet guesses matter more than lower ones.
(ii) All w(n)=0 except w(5)=1. Believe it or not, this is really good at predicting humans and there isn't any science behind it.

The website is solely about #1. InForm demo uses #2.

So what's new? Here we go.....

I wanted to think up a general-enough scheme for the weight function w(n) that covers most of "weight space", which is to say - I want a way to systematically guess at these weights. The model that's in play right now is as follows:

(i) Each w(n) is either a 0 or a 1. Either that guess counts, or it doesn't. No further weighting beyond that for now.
(ii) Lining up each w(n) in a row, this might, for instance look like 0100111010. (This means w(1)=0, w(2)=1, w(3)=0, etc.)
(iii) Observe that 0100111010 is itself a binary number. The lowest of these has all 0's: 0000000000. The highest has ten 1's: 1111111111
(iv) Thus, we can cycle through every single binary model by counting from 0000000000 to 1111111111 in binary.
(v) With that realized, test the program on a standardized piece of data and collect statistics on each model. The best model will stand out.

If you follow all that, you're caught up to what my code is doing right now. At the moment I've got it training on just a single sequence, and that's the one provided by Luke. Turns out the AI has already found a model better than the one I was using and the program's not even finished running yet. I know it's early, so results may vary.

Either way. here's what's going on:

Code: QB64: [Select]
  1.  
  2. Screen _NewImage(120, 40)
  3.  
  4. ' Version: 20
  5.  
  6. Type LetterBin
  7.     Signature As String
  8.     Count As Integer
  9.  
  10. Dim Shared Alphabet1(2) As LetterBin ' 0 1
  11. Dim Shared Alphabet2(4) As LetterBin ' 00 01 10 11
  12. Dim Shared Alphabet3(8) As LetterBin ' 000 001 010 011 100 101 110 111
  13. Dim Shared Alphabet4(16) As LetterBin ' etc.
  14. Dim Shared Alphabet5(32) As LetterBin
  15. Dim Shared Alphabet6(64) As LetterBin
  16. Dim Shared Alphabet7(128) As LetterBin
  17. Dim Shared Alphabet8(256) As LetterBin
  18. Dim Shared Alphabet9(512) As LetterBin
  19. Dim Shared Alphabet10(1024) As LetterBin
  20. Dim Shared Alphabet11(2048) As LetterBin
  21. Dim Shared Alphabet12(4096) As LetterBin
  22. Dim Shared Alphabet13(8192) As LetterBin
  23.  
  24. Alphabet1(1).Signature = "0"
  25. Alphabet1(2).Signature = "1"
  26. Call NewAlphabet(Alphabet1(), Alphabet2())
  27. Call NewAlphabet(Alphabet2(), Alphabet3())
  28. Call NewAlphabet(Alphabet3(), Alphabet4())
  29. Call NewAlphabet(Alphabet4(), Alphabet5())
  30. Call NewAlphabet(Alphabet5(), Alphabet6())
  31. Call NewAlphabet(Alphabet6(), Alphabet7())
  32. Call NewAlphabet(Alphabet7(), Alphabet8())
  33. Call NewAlphabet(Alphabet8(), Alphabet9())
  34. Call NewAlphabet(Alphabet9(), Alphabet10())
  35. Call NewAlphabet(Alphabet10(), Alphabet11())
  36. Call NewAlphabet(Alphabet11(), Alphabet12())
  37. Call NewAlphabet(Alphabet12(), Alphabet13())
  38.  
  39. ' Load test data.
  40. ReDim Shared TestData(10000) As String
  41. ReDim _Preserve TestData(LoadTestData(0))
  42.  
  43. ' This is the made-up part of the model.
  44. Dim Shared AlphaWeight(1 To 13) As Double
  45.  
  46. ' Statistics and metrics:
  47. Dim GuessPredicted As Integer
  48. Dim GuessCorrect As Double
  49. Dim GuessTotal As Double
  50. Dim GuessRatioMax As Double
  51. Dim GuessStreak As Integer
  52. Dim GuessStreakMax As Integer
  53. Dim Grade(10000, 2) As Double
  54.  
  55. Dim TheString As String
  56. Dim As Integer k, m, n
  57.  
  58. GuessRatioMax = 0
  59.  
  60. Dim BinaryModelCounter As Integer
  61. Dim BinaryModelBest As Integer
  62. BinaryModelCounter = 0
  63.  
  64. Do While (BinaryModelCounter < 1024)
  65.     Call InitializeBinaryModel(BinaryModelCounter)
  66.     BinaryModelCounter = BinaryModelCounter + 1
  67.  
  68.     '''
  69.     ' Bypass pre-cooked test data.
  70.     TestData(1) = "01100101001010001100001101101111011010010101010110110101001000001111001111110101000101111011010101111101010101101010101001010101011000010101010101001011010100110100110100110011010101010101110101010111111101011010100000001101111000010111000110111001000010100001101010110100000111101011111100001011001010110010110"
  71.     ReDim _Preserve TestData(1)
  72.     '''
  73.  
  74.     For m = 1 To UBound(TestData)
  75.  
  76.         GuessPredicted = -1
  77.         GuessCorrect = 0
  78.         GuessTotal = 0
  79.         GuessStreak = 0
  80.         GuessStreakMax = 0
  81.  
  82.         For n = 1 To Len(TestData(m)) '9999
  83.  
  84.             '''
  85.             ' Research Mode
  86.             TheString = Left$(TestData(m), n)
  87.             '''
  88.  
  89.             '''
  90.             '' Gaming Mode
  91.             'Cls
  92.             'Locate 1, 1
  93.             'Print "Press LEFT or RIGHT."
  94.             'k = 0
  95.             'Do: k = _KeyHit: Loop Until ((k = 19200) Or (k = 19712))
  96.             'Select Case k
  97.             '    Case 19200
  98.             '        TheString = TheString + "0"
  99.             '    Case 19712
  100.             '        TheString = TheString + "1"
  101.             'End Select
  102.             '_KeyClear
  103.             '''
  104.  
  105.             Cls
  106.             Color 7
  107.             Locate 1, 1
  108.             For k = 1 To _Width
  109.                 Print "_";
  110.             Next
  111.             Print "Model:";
  112.             For k = 1 To 10 'UBound(AlphaWeight)
  113.                 Print AlphaWeight(k);
  114.             Next
  115.             Print
  116.             Print
  117.             Print "Sequence (length "; _Trim$(Str$(Len(TheString))); "):"
  118.             Print TheString ';
  119.             Color 8
  120.             'Print Right$(TestData(m), Len(TestData(m)) - n)
  121.             Color 7
  122.  
  123.             ' Reconciliation
  124.             If (GuessPredicted <> -1) Then
  125.                 Print
  126.                 Print "I predicted "; _Trim$(Str$(GuessPredicted)); " and you typed "; Right$(TheString, 1); "."
  127.                 If (GuessPredicted = Val(Right$(TheString, 1))) Then
  128.                     Print "I am RIGHT this round."
  129.                     GuessCorrect = GuessCorrect + 1
  130.                     GuessStreak = GuessStreak + 1
  131.                     If (GuessStreak > GuessStreakMax) Then GuessStreakMax = GuessStreak
  132.                     Grade(n, 2) = 1
  133.                 Else
  134.                     Print "I am WRONG this round."
  135.                     GuessStreak = 0
  136.                     Grade(n, 2) = 0
  137.                 End If
  138.                 GuessTotal = GuessTotal + 1
  139.                 Grade(n, 1) = GuessCorrect / GuessTotal
  140.             End If
  141.  
  142.             If (GuessTotal > 0) Then
  143.                 Print
  144.                 Print "I'm on a "; _Trim$(Str$(GuessStreak)); "-round winning streak."
  145.                 Print "My best streak has been "; _Trim$(Str$(GuessStreakMax)); "."
  146.                 If (GuessTotal <> 0) Then
  147.                     Print "My correctness rate is "; _Trim$(Str$(Int(100 * GuessCorrect / GuessTotal))); "% in "; _Trim$(Str$(GuessTotal)); " guesses."
  148.                 End If
  149.             End If
  150.  
  151.             GuessPredicted = Analyze(TheString, AlphaWeight(), 0)
  152.  
  153.             Print
  154.             'Print "I have made a new prediction."
  155.             'Print "Press LEFT or RIGHT to test me."
  156.             Print "The best model was # "; _Trim$(Str$(BinaryModelBest)); ", rated "; _Trim$(Str$(Int(GuessRatioMax * 100))); "%"
  157.  
  158.             ' Draw bottom graph
  159.             If (CsrLin <= 23) Then
  160.                 If (GuessTotal <> 0) Then
  161.                     Call PrintGraph(TheString, Grade())
  162.                 End If
  163.             End If
  164.  
  165.             _Display
  166.             '_Delay .02
  167.             _Limit 240
  168.         Next
  169.  
  170.         If (GuessCorrect / GuessTotal > GuessRatioMax) Then
  171.             BinaryModelBest = BinaryModelCounter
  172.             GuessRatioMax = GuessCorrect / GuessTotal
  173.         End If
  174.  
  175.         _Display
  176.         _Delay 1
  177.     Next
  178.  
  179.  
  180. Sub InitializeBinaryModel (TheIndexIn As Integer)
  181.     '0 to 1023
  182.     Dim As Integer k
  183.     Dim As String BinWeight
  184.     BinWeight = BIN$(TheIndexIn)
  185.     For k = 1 To 10
  186.         AlphaWeight(k) = Val(Mid$(BinWeight, 10 - k + 1, 1))
  187.     Next
  188.     AlphaWeight(11) = 0
  189.     AlphaWeight(12) = 0
  190.     AlphaWeight(13) = 0
  191.  
  192.     Dim As Integer max, i, msb
  193.     Dim As String b
  194.     max% = 8 * Len(n%) ': MSB% = 1   'uncomment for 16 (32 or 64) bit returns
  195.     For i = max% - 1 To 0 Step -1 'read as big-endian MSB to LSB
  196.         If (n% And 2 ^ i) Then msb% = 1: b$ = b$ + "1" Else If msb% Then b$ = b$ + "0"
  197.     Next
  198.     b$ = "0000000000" + b$
  199.     b$ = Right$(b$, 10)
  200.     If b$ = "" Then BIN$ = "0" Else BIN$ = b$ 'check for empty string
  201.  
  202. Sub InitializeCustomModel
  203.     Dim As Integer k
  204.     For k = LBound(AlphaWeight) To UBound(AlphaWeight)
  205.         AlphaWeight(k) = 0 * k ^ 2
  206.     Next
  207.     'AlphaWeight(1) = 0
  208.     'AlphaWeight(2) = 0
  209.     'AlphaWeight(3) = 0
  210.     'AlphaWeight(4) = 0
  211.     AlphaWeight(5) = 1
  212.     'AlphaWeight(6) = 0
  213.     'AlphaWeight(7) = 0
  214.     'AlphaWeight(8) = 0
  215.     'AlphaWeight(9) = 0
  216.     'AlphaWeight(10) = 0
  217.     AlphaWeight(11) = 0
  218.     AlphaWeight(12) = 0
  219.     AlphaWeight(13) = 0
  220.  
  221. Function Analyze (TheStringIn As String, arrweight() As Double, pswitch As Integer)
  222.     Dim TheReturn As Integer
  223.     Dim As Integer n
  224.     Dim As Double r, j, k
  225.     Dim StringPhase(UBound(arrweight)) As String
  226.     Dim Partialguess(LBound(arrweight) To UBound(arrweight), 2) As Double
  227.  
  228.     StringPhase(1) = TheStringIn
  229.     'For n = 2 To UBound(StringPhase) ' Uncomment for phase analysis.
  230.     'StringPhase(n) = Right$(StringPhase(n - 1), Len(StringPhase(n - 1)) - 1) + Left$(StringPhase(n - 1), 1)
  231.     'Next
  232.  
  233.     ' Initialize partial results.
  234.     For n = LBound(Partialguess) To UBound(Partialguess)
  235.         Partialguess(n, 1) = -999
  236.     Next
  237.  
  238.     If (pswitch = 1) Then
  239.         Print
  240.         For n = 1 To _Width
  241.             Print "-";
  242.         Next
  243.         Print
  244.     End If
  245.  
  246.     If (arrweight(1) <> 0) Then Call CreateHisto(StringPhase(), 1, Alphabet1())
  247.     If (arrweight(2) <> 0) Then Call CreateHisto(StringPhase(), 2, Alphabet2())
  248.     If (arrweight(3) <> 0) Then Call CreateHisto(StringPhase(), 3, Alphabet3())
  249.     If (arrweight(4) <> 0) Then Call CreateHisto(StringPhase(), 4, Alphabet4())
  250.     If (arrweight(5) <> 0) Then Call CreateHisto(StringPhase(), 5, Alphabet5())
  251.     If (arrweight(6) <> 0) Then Call CreateHisto(StringPhase(), 6, Alphabet6())
  252.     If (arrweight(7) <> 0) Then Call CreateHisto(StringPhase(), 7, Alphabet7())
  253.     If (arrweight(8) <> 0) Then Call CreateHisto(StringPhase(), 8, Alphabet8())
  254.     If (arrweight(9) <> 0) Then Call CreateHisto(StringPhase(), 9, Alphabet9())
  255.     If (arrweight(10) <> 0) Then Call CreateHisto(StringPhase(), 10, Alphabet10())
  256.     If (arrweight(11) <> 0) Then Call CreateHisto(StringPhase(), 11, Alphabet11())
  257.     If (arrweight(12) <> 0) Then Call CreateHisto(StringPhase(), 12, Alphabet12())
  258.     If (arrweight(13) <> 0) Then Call CreateHisto(StringPhase(), 13, Alphabet13())
  259.  
  260.     If (pswitch = 1) Then ' Set the last argument >=1 to print stats for that histogram.
  261.         If ((Len(TheStringIn) >= 1) And (arrweight(1) <> 0)) Then Call PrintHisto(Alphabet1(), 0)
  262.         If ((Len(TheStringIn) >= 2) And (arrweight(2) <> 0)) Then Call PrintHisto(Alphabet2(), 0)
  263.         If ((Len(TheStringIn) >= 3) And (arrweight(3) <> 0)) Then Call PrintHisto(Alphabet3(), 0)
  264.         If ((Len(TheStringIn) >= 4) And (arrweight(4) <> 0)) Then Call PrintHisto(Alphabet4(), 0)
  265.         If ((Len(TheStringIn) >= 5) And (arrweight(5) <> 0)) Then Call PrintHisto(Alphabet5(), 4)
  266.         If ((Len(TheStringIn) >= 6) And (arrweight(6) <> 0)) Then Call PrintHisto(Alphabet6(), 0)
  267.         If ((Len(TheStringIn) >= 7) And (arrweight(7) <> 0)) Then Call PrintHisto(Alphabet7(), 0)
  268.         If ((Len(TheStringIn) >= 8) And (arrweight(8) <> 0)) Then Call PrintHisto(Alphabet8(), 0)
  269.         If ((Len(TheStringIn) >= 9) And (arrweight(9) <> 0)) Then Call PrintHisto(Alphabet9(), 0)
  270.         If ((Len(TheStringIn) >= 10) And (arrweight(10) <> 0)) Then Call PrintHisto(Alphabet10(), 0)
  271.         If ((Len(TheStringIn) >= 11) And (arrweight(11) <> 0)) Then Call PrintHisto(Alphabet11(), 0)
  272.         If ((Len(TheStringIn) >= 12) And (arrweight(12) <> 0)) Then Call PrintHisto(Alphabet12(), 0)
  273.         If ((Len(TheStringIn) >= 13) And (arrweight(13) <> 0)) Then Call PrintHisto(Alphabet13(), 0)
  274.         Print
  275.     End If
  276.  
  277.     If ((Len(TheStringIn) >= 1) And (arrweight(1) <> 0)) Then Call MakeGuess(TheStringIn, 1, Alphabet1(), Partialguess(), 0) ' Set the last argument =1 to print guess for that histogram.
  278.     If ((Len(TheStringIn) >= 2) And (arrweight(2) <> 0)) Then Call MakeGuess(TheStringIn, 2, Alphabet2(), Partialguess(), 0)
  279.     If ((Len(TheStringIn) >= 3) And (arrweight(3) <> 0)) Then Call MakeGuess(TheStringIn, 3, Alphabet3(), Partialguess(), 0)
  280.     If ((Len(TheStringIn) >= 4) And (arrweight(4) <> 0)) Then Call MakeGuess(TheStringIn, 4, Alphabet4(), Partialguess(), 0)
  281.     If ((Len(TheStringIn) >= 5) And (arrweight(5) <> 0)) Then Call MakeGuess(TheStringIn, 5, Alphabet5(), Partialguess(), pswitch)
  282.     If ((Len(TheStringIn) >= 6) And (arrweight(6) <> 0)) Then Call MakeGuess(TheStringIn, 6, Alphabet6(), Partialguess(), 0)
  283.     If ((Len(TheStringIn) >= 7) And (arrweight(7) <> 0)) Then Call MakeGuess(TheStringIn, 7, Alphabet7(), Partialguess(), 0)
  284.     If ((Len(TheStringIn) >= 8) And (arrweight(8) <> 0)) Then Call MakeGuess(TheStringIn, 8, Alphabet8(), Partialguess(), 0)
  285.     If ((Len(TheStringIn) >= 9) And (arrweight(9) <> 0)) Then Call MakeGuess(TheStringIn, 9, Alphabet9(), Partialguess(), 0)
  286.     If ((Len(TheStringIn) >= 10) And (arrweight(10) <> 0)) Then Call MakeGuess(TheStringIn, 10, Alphabet10(), Partialguess(), 0)
  287.     If ((Len(TheStringIn) >= 11) And (arrweight(11) <> 0)) Then Call MakeGuess(TheStringIn, 11, Alphabet11(), Partialguess(), 0)
  288.     If ((Len(TheStringIn) >= 12) And (arrweight(12) <> 0)) Then Call MakeGuess(TheStringIn, 12, Alphabet12(), Partialguess(), 0)
  289.     If ((Len(TheStringIn) >= 13) And (arrweight(13) <> 0)) Then Call MakeGuess(TheStringIn, 13, Alphabet13(), Partialguess(), 0)
  290.     If (pswitch = 1) Then Print
  291.  
  292.     If (pswitch = 1) Then
  293.         Print "Thinking:";
  294.         For k = LBound(Partialguess) To UBound(Partialguess)
  295.             If (Partialguess(k, 1) <> -999) Then
  296.                 Print Partialguess(k, 1);
  297.             Else
  298.                 Print "_ ";
  299.             End If
  300.         Next
  301.         Print
  302.     End If
  303.  
  304.     j = 0
  305.     r = 0
  306.  
  307.     ' Weighted average calculation
  308.     For k = UBound(Partialguess) To LBound(Partialguess) Step -1
  309.         If (Partialguess(k, 1) <> -999) Then
  310.             r = r + arrweight(k) * Partialguess(k, 1)
  311.             j = j + arrweight(k)
  312.         End If
  313.     Next
  314.     If (j <> 0) Then
  315.         r = r / j
  316.     End If
  317.  
  318.     If (pswitch = 1) Then Print "Predicting:  "; _Trim$(Str$(r))
  319.  
  320.     If (r > .5) Then
  321.         r = 1
  322.     Else
  323.         r = 0
  324.     End If
  325.  
  326.     If (pswitch = 1) Then
  327.         Print "Rounding to: "; _Trim$(Str$(r))
  328.     End If
  329.  
  330.     If (pswitch = 1) Then
  331.         For n = 1 To _Width
  332.             Print "-";
  333.         Next
  334.         Print
  335.     End If
  336.  
  337.     TheReturn = r
  338.     Analyze = TheReturn
  339.  
  340. Sub MakeGuess (TheStringIn As String, wid As Integer, arralpha() As LetterBin, arrguess() As Double, pswitch As Integer)
  341.     Dim TheReturn As Double
  342.     Dim As Integer j, k, n
  343.     TheReturn = 0
  344.     j = 1
  345.     k = 0
  346.     For n = 1 To UBound(arralpha)
  347.         If (Left$(arralpha(n).Signature, wid - 1) = Right$(TheStringIn, wid - 1)) Then
  348.             If (arralpha(n).Count >= j) Then
  349.                 If (pswitch = 1) Then Print "Order-"; Right$("0" + _Trim$(Str$(wid)), 2); " guess: "; arralpha(n).Signature; " . "; _Trim$(Str$(arralpha(n).Count))
  350.                 TheReturn = TheReturn + Val(Right$(arralpha(n).Signature, 1))
  351.                 k = k + 1
  352.                 j = arralpha(n).Count
  353.             End If
  354.         End If
  355.     Next
  356.     If (k <> 0) Then
  357.         TheReturn = TheReturn / k
  358.     Else
  359.         TheReturn = .5
  360.     End If
  361.     arrguess(wid, 1) = TheReturn
  362.     arrguess(wid, 2) = j
  363.  
  364. Sub CreateHisto (arrfinger() As String, wid As Integer, arralpha() As LetterBin)
  365.     Dim As Integer j, k, n
  366.     For n = 1 To UBound(arralpha)
  367.         arralpha(n).Count = 0
  368.     Next
  369.     ' Uncomment this loop to enable phase analysis.
  370.     'For j = 1 To wid
  371.     j = 1
  372.     For k = 1 To Len(arrfinger(j)) - (Len(arrfinger(j)) Mod wid) Step wid
  373.         For n = 1 To UBound(arralpha)
  374.             If (Mid$(arrfinger(j), k, wid) = arralpha(n).Signature) Then
  375.                 arralpha(n).Count = arralpha(n).Count + 1
  376.             End If
  377.         Next
  378.     Next
  379.     'Next
  380.     Call QuickSort(arralpha(), 1, UBound(arralpha))
  381.  
  382. Sub PrintHisto (arr() As LetterBin, wid As Integer)
  383.     Dim As Integer j, n
  384.     If (wid > 0) Then
  385.         If (wid > UBound(arr)) Then
  386.             j = UBound(arr)
  387.         Else
  388.             j = wid
  389.         End If
  390.         Print "Histogram: "; _Trim$(Str$(UBound(arr))); "-letter regroup, showing top "; _Trim$(Str$(wid))
  391.         For n = 1 To j
  392.             Print arr(n).Signature; arr(n).Count
  393.         Next
  394.     End If
  395.  
  396. Sub PrintGraph (TheString As String, arrgrade() As Double)
  397.     Dim As Integer j, k
  398.     Dim As Double f, g
  399.     For k = 1 To _Width
  400.         Locate _Height - 5, k: Print "_"
  401.         Locate _Height - 5 - 10, k: Print "_"
  402.     Next
  403.     Locate _Height - 5 + 1, 1: Print "0%"
  404.     Locate _Height - 5 - 10 - 1, 1: Print "100%"
  405.     f = (_Width) / Len(TheString)
  406.     If (f > 1) Then f = 1
  407.     For j = 2 To Len(TheString)
  408.         g = Int(j * f)
  409.         If (g = 0) Then g = 1
  410.         Locate _Height - 5 - Int(10 * arrgrade(j, 1)), g
  411.         If (arrgrade(j, 2) = 1) Then
  412.             Print Chr$(251)
  413.         Else
  414.             Print "x"
  415.         End If
  416.     Next
  417.  
  418. Sub NewAlphabet (arrold() As LetterBin, arrnew() As LetterBin)
  419.     Dim As Integer j, k, n
  420.     n = 0
  421.     For k = 1 To 2
  422.         For j = 1 To UBound(arrold)
  423.             n = n + 1
  424.             arrnew(n).Signature = arrold(j).Signature
  425.         Next
  426.     Next
  427.     For j = 1 To UBound(arrnew)
  428.         If (j <= UBound(arrnew) / 2) Then
  429.             arrnew(j).Signature = "0" + arrnew(j).Signature
  430.         Else
  431.             arrnew(j).Signature = "1" + arrnew(j).Signature
  432.         End If
  433.     Next
  434.  
  435. Sub QuickSort (arr() As LetterBin, LowLimit As Long, HighLimit As Long)
  436.     Dim As Long piv
  437.     If (LowLimit < HighLimit) Then
  438.         piv = Partition(arr(), LowLimit, HighLimit)
  439.         Call QuickSort(arr(), LowLimit, piv - 1)
  440.         Call QuickSort(arr(), piv + 1, HighLimit)
  441.     End If
  442.  
  443. Function Partition (arr() As LetterBin, LowLimit As Long, HighLimit As Long)
  444.     Dim As Long i, j
  445.     Dim As Double pivot, tmp
  446.     pivot = arr(HighLimit).Count
  447.     i = LowLimit - 1
  448.     For j = LowLimit To HighLimit - 1
  449.         tmp = arr(j).Count - pivot
  450.         If (tmp >= 0) Then
  451.             i = i + 1
  452.             Swap arr(i), arr(j)
  453.         End If
  454.     Next
  455.     Swap arr(i + 1), arr(HighLimit)
  456.     Partition = i + 1
  457.  
  458. 'Function Pathological$ (TheSeed As String, TheLength As Integer)
  459. '    Dim TheReturn As String
  460. '    TheReturn = TheSeed
  461. '    Dim p
  462. '    Do
  463. '        Cls
  464. '        Locate 1, 1
  465. '        Print TheReturn;
  466. '        p = Analyze(TheReturn, 0)
  467. '        If (p = 1) Then
  468. '            TheReturn = TheReturn + "0"
  469. '        Else
  470. '            TheReturn = TheReturn + "1"
  471. '        End If
  472. '    Loop Until Len(TheReturn) = TheLength
  473. '    Pathological$ = TheReturn
  474. 'End Function
  475.  
  476. Function LoadTestData (alwayszero As Integer)
  477.     Dim n As Integer
  478.     n = alwayszero
  479.  
  480.     '''
  481.     ' Percussive cases:
  482.     '''
  483.     n = n + 1: TestData(n) = "1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111"
  484.     n = n + 1: TestData(n) = "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
  485.     n = n + 1: TestData(n) = "0101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101"
  486.     n = n + 1: TestData(n) = "1010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010"
  487.     n = n + 1: TestData(n) = "0001110011000111001100011100110001110011000111001100011100110001110011000111001100011100110001110011000111001100011100110001110011000111001100011100110001110011"
  488.     n = n + 1: TestData(n) = "0100010111010001011101000101110100010111010001011101000101110100010111010001011101000101110100010111010001011101000101110100010111010001011101000101110100010111"
  489.  
  490.     '''
  491.     ' Human samples:
  492.     '''
  493.     ' (from Keybone)
  494.     n = n + 1: TestData(n) = "101010101010101010101001010101010101001010111001010101010101010101010100010101010101010100101001010101001100101010001010100101010100101010100101010101010101010011011110010101010100100101010110010011001010011001010100010100101010010101010101010010101010101010010101001010101010100110010101010100101010101010011001001010100101010010101010100101010010101001010100101001010010101010111010100110011001010101010100110101001010101010100101001010111010101010101010100101001010101010010101010101001010101001010101001010100101010100101010010101010101001010101001010101010101001010101001010100101010101010010101010010010101010101010101010010100101010101001010100101001010101001111101010101010100101010110011001010101010101010110101010101101010101010100101010010101010010101010101101110010101001010101010110010100101010101001011010101010100110101010100101010010101010100101010101001010101010101001010101010011010101010101110110100101010111010101011011001011001010101001010101010101010101010011001010101010100101010101010101010010100101"
  495.     ' (from Keybone)
  496.     n = n + 1: TestData(n) = "0101110101100011010100101011001110001011001010001110101111010100111011100100101001010011110101101000101010001010101111001010111010101010100001010101000101101100101111101010010101110110111001000101000011010101010001001001001111101011101010100010110101110101100000101010101110111010100100100001110111100101011110101010001010001110010110111110110010101001001011101000101001011100011101000010101010101101010010110100101101000101111010101110111001010011101111010101000010101111100010101011110101011011110100001010110"
  497.     ' (from Loudar)
  498.     n = n + 1: TestData(n) = "1011001010010100100100110010101010101001010101010101011010010101001010101001010010100110101011010101010101011010101101010101010101010010110101010101100101010101010110101101011010010101010010100110101101001010110101011010010101101010110100101111010101010011011011010010110101010010110100101101010100101011010010101001010101010001011101011010010101011100111010010001101011110010011010001011100110101010010011010101001001010010000101010110001"
  499.     ' (from Luke)
  500.     n = n + 1: TestData(n) = "01100101001010001100001101101111011010010101010110110101001000001111001111110101000101111011010101111101010101101010101001010101011000010101010101001011010100110100110100110011010101010101110101010111111101011010100000001101111000010111000110111001000010100001101010110100000111101011111100001011001010110010110"
  501.     ' (from Sarafromct)
  502.     n = n + 1: TestData(n) = "10101010101011101000011101010111010101010101100111001010100111100001011011110101000001111010101101010000001111110011111110111101110111001110110010000100010101010101010100101011010110101010101010101001000000001111110000011110101010101010100010101110101010101101111111111111111111101010101010101000000"
  503.     ' (from Spriggs)
  504.     n = n + 1: TestData(n) = "10111010101010101010101001010101010101001010101001010101010101010101010101010101010101010101010101010101001010100100100101010101010101001010100101010101010100101010100101010101010101010101001010010110010101010010101010101010101010101010100101001001001010101010101010101010101001010101001001101010010"
  505.     ' (from Spriggs)
  506.     n = n + 1: TestData(n) = "11111011110100101011111111110100000011011110101100111100111111110111101110100111100110011111110101111111010111101111100111110111111111111011100111110111111110010000101011111001110101101010110111110"
  507.     ' (from Hotpants)
  508.     n = n + 1: TestData(n) = "01010100011001010010101010101010101000110101010111101010100100011010101010100100101110010010010100001010101001010101010110010001001011000100100110101001001001010000000001010101101111101001010100010101001001010101000100101001100100010011010101010101010111010010101011101011011010110100100010010100100100010010001001"
  509.  
  510.     LoadTestData = n
  511.  
« Last Edit: December 20, 2021, 02:11:27 pm by STxAxTIC »
You're not done when it works, you're done when it's right.

Offline random1

  • Newbie
  • Posts: 86
Re: Looking for old program or help recreating it
« Reply #80 on: December 20, 2021, 09:22:22 pm »
STxAxTIC

Very nice work.  One thing that really caught my attention was ranking the strings as to their
level of randomness.

I have two models I am currently working on.  The one I am interested in most is based on a
different type of data although the strings look very similar to those discussed so far. The idea
for this predictor is to first find the strings that show a high probability of being predictable and
process only those strings.  Second is to only take the (1) predictions.  If the prediction is 0 or ?
then toss it out.

This tool only processes 100 to 112 total strings and out of those I need the top 15 predicted 1's.
The more I study the linked information the more convinced I am that it may be possible.
       
Thanks again, again, this must be very time consuming on your end.  I will say that I am having
fun and learning at the same time.  Not many people would go to such extent, it is appreciated. 

R1   

Offline random1

  • Newbie
  • Posts: 86
Re: Looking for old program or help recreating it
« Reply #81 on: December 23, 2021, 02:50:51 am »
Here is a older predictor that I rewrote for this topic.  This works a little similar to the
one STxAxTIC has posted.  This tool has no brains so to say and should be easy to
understand.  I attached a picture that shows the results and a second file which contains
the data string file.  You will notice some of the strings are all *****.  These are events
that are no longer collected but left in place to maintain the data structure.  These are
skipped by the dummy predictor.  Anyone willing can try to improve the overall hit rate
is very welcome.  I am most interested in bringing up the number of correct (1's) made
by the predictor.  The data file needs to be in the same directory as the program or one
could edit the code and add a full path to the open statement. 

Anyway, maybe some brains can be added to make it better.  This is the second of two
predictors I am working on.  The other is the one STxAxTIC posted.  My code is most likely
outdated, but I am old and set in my ways.

Code: QB64: [Select]
  1. Title1$ = "Predictor"
  2. _Title Title1$
  3. A& = _NewImage(400,200,32)
  4.  
  5. Dim PreDiction (1 to 112) as String
  6. Dim StrLen as Double
  7. Dim Match as Double
  8. Dim Count as Double
  9. PrintOn=1  '<- PrintSwitch
  10. StrLen=0  '0 = Use entire string
  11. Color _RGB32(255,255,0),_RGB32(0,0,0)
  12.  
  13. 'String feed from file
  14. Count=0:Match=0:Dud=0
  15. Open "tmp.txt" For Input as #1
  16. Line Input #1, Dat1$
  17. Dat1$=_trim$(Dat1$)
  18. If StrLen > 0 Then Dat1$=Mid$(Dat1$,1,StrLen)  '<- Control Panel Setting to control length of String
  19. Count=Count+1
  20. Goto GotString
  21. ReTurn1:
  22.  
  23. 'Print & exit code
  24. If PrintOn = 1 Then _printString (4,84), "Correct Predictions = " + _Trim$(Str$(Match))
  25. If PrintOn = 1 Then _PrintString (4,100), "Predictor Hit Rate = " + Mid$(_Trim$(Str$(Match/(112-Dud))),1,4) + "% of " + _Trim$(Str$(112-Dud))
  26. If PrintOn = 1 Then _PrintString (4,116), "Strings Not Processed = " + _Trim$(Str$(Dud))
  27. If PrintOn = 1 Then _PrintString (4,132), "Finished....."
  28. Color _RGB32(192,192,192),_RGB32(0,0,0)
  29. _PrintString (4,180), "Press any key to exit"
  30.  
  31. GotString:
  32. If Instr(Dat1$,"*") > 0 Then Dud=Dud+1
  33. If Instr(Dat1$,"*") > 0 Then Goto SkipString 'Skips invalid strings
  34. If PrintOn = 1 Then _PrintString (4, 2), "Analyzing String " + _Trim$(Str$(Count)) + " of 112"
  35. If PrintOn = 1 Then _PrintString (4,20), "Partial String = " + Mid$(Dat1$,1,30)
  36.  
  37. 'Dummy Prediction code Start's here
  38.  
  39. Cyc=4  '<-Control Panel Adjustable
  40. H0=0:H1=0
  41. NextCyc:
  42.  
  43. Pat0$="0"+Mid$(Dat1$,2,Cyc)
  44. Pat1$="1"+Mid$(Dat1$,2,Cyc)
  45.  
  46. L1=1
  47.   Do While L1 <= Len(Dat1$)-Len(Pat0$)
  48.       If Mid$(Dat1$,L1,Len(Pat0$)) = Pat0$ Then H0=H0+1
  49.       If Mid$(Dat1$,L1,Len(Pat1$)) = Pat1$ Then H1=H1+1
  50.      L1=L1+1
  51.   Loop
  52. Cyc=Cyc+1
  53. If Cyc <= 6 Then Goto NextCyc 'Control Panel adjustable
  54.  
  55. 'Dummy Prediction
  56. If H1 >= H0 Then PreDiction(Count)="1" Else PreDiction(Count)="0"
  57.  
  58. 'Counts and print stuff
  59. If PreDiction(Count) = Mid$(Dat1$,1,1) Then Match=Match+1
  60. If PrintOn = 1 then _PrintString (4,36), "Prediction = " + PreDiction(Count) + " "
  61. If Mid$(Dat1$,1,1) = PreDiction(Count) And Mid$(Dat1$,1,1) ="0" Then Hit0=Hit0+1
  62. If Mid$(Dat1$,1,1) = PreDiction(Count) And Mid$(Dat1$,1,1) ="1" Then Hit1=Hit1+1
  63. If PrintOn = 1 then _PrintString (4,52), "P-Match->(0) = " + _Trim$(Str$(Hit0))
  64. If PrintOn = 1 then _PrintString (4,68), "P-Match->(1) = " + _Trim$(Str$(Hit1))
  65. SkipString:
  66. Goto ReTurn1 'get next string
  67.  

R1

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
Re: Looking for old program or help recreating it
« Reply #82 on: December 23, 2021, 03:51:04 am »
Hey r1,

Funny story about tonight - 'cause time felt about right - I was about to try to collect a few recent thoughts on this whole thing and make a new reply, but got sidetracked, only to refresh the forum and see you had the same idea but didn't get sidetracked - you managed to make a coherent post, unlike myself. Later on I'll split my brain and see what's going on inside your predictor, but first I wanted to give an update on what my code is up to. The code itself is pretty stable, but the way I now use it needs to be looked at.

Just some points for review:
(i) Predictions (as an unrounded decimal) are P = N (w(1)*g(1) + w(2)g(2) + ... + w(10)g(10))
(ii) N is a normalization constant
(iii) g(n) is the guess for alphabet size n
(iv) w(n) is the weight of that guess, a 0 or a 1

That stuff must be a thousand percent clear to proceed with me properly. When I say I  "use a model", or "choose a model", all that means is to choose w(n) for each n=1,2,...,10. For a stupid example, setting all w(n)=0 just makes every prediction 0. For another example, setting all w(n)=1 gives equal weight to all n guesses that contribute to the final prediction. Turning on or off various w(n) like light switches gives a different model.

Alright, so lately I've been cycling through all possible w(n) and testing on many kinds of input sequences, and am finding - rather verifying - a few results that I always had a hunch about. This is motivated by noticing that, for some reason, inputs made by human beings are very strong in the w(5)-range, but altogether absent in higher ranges. It's as if the random number generator inside a human is great at sputtering out chunks of 5 or even 7, but not flurries of 8 or 12. Kinda amazing. Certain contrived inputs, like regular patterns, complex patterns, drum beats, etc... are all resonant in various w(n) that make sense when you look at them, these are usually nice and low w(n) as well.

So let me do an example. Working with *only* the first string in the file you attached, namely:

Code: [Select]
S = 11000110100100010010000101001001000000000100010000001000011000000001010000000010010000000110011110000001110101100000001100000000000010100000100100111100001000011111100000010000100100000000001110000001100010000000000100000110000000000100000000010000110000100001000000000000001000110000011111111111111001110000011000001100000001101001000110001110000000010000001111000000000100000001110001001000000010010001001000000001000000000000000000110000010000001000001000010001000001000010111000000001100011100100000000100011000000000001100010000010000100000000000000001000000001010001100000001101000000000100000000000001000000000001110010001110010011001000000101000000110000000000001000000000101000110000000000000000001100000000000000
(I)
Let me use the model with w(1)=1, w(2)=1, etc, ... all w(n)=1. The perfectly averaged model, every frequency gets the same weight. Running this, I get a result of: 74%. Not bad! This mode always does a pretty good job.

(II)
To repeat the past, I can also use the w(n)=n^2 model. Remember that ole thing? This one gives an answer of: 69%. Yuck. Glad we updated the model since the n^2 days.

(III)
Okay, so can we do better than stab around randomly for a model? Yes. By systematically searching, I found the best results in the 533rd model (there may be a better one after 533 but I stopped the program there). Converting 533 to binary, this means the model is: w(1)=1, w(2)=0, w(3)=1, w(4)=0, w(5)=1, w(6)=0, w(7)=0, w(8)=0, w(9)=0, w(10)=1. Okay, so choosing this model 1010100001 and checking the result, we find a success rate of 76%, the highest yet!

So clearly it's worth stepping around in "weight space" for the best model for a given sequence. Humans have their own signature like 000010000. Simple "music" has its own, typically something like 0110000000. Whatever you used to come up with that first string in TMP.txt, there's something significant about 1010100001 when it comes to cracking it. This is all coming to a grand conclusion that says: sequence can be boiled down to a frequency fingerprint. Kinda like Fourier analysis.

Let me know if I'm lecturing to an empty classroom or if you get what I'm fiddling with here, thanks!
« Last Edit: December 23, 2021, 04:02:51 am by STxAxTIC »
You're not done when it works, you're done when it's right.

Offline random1

  • Newbie
  • Posts: 86
Re: Looking for old program or help recreating it
« Reply #83 on: December 23, 2021, 05:40:29 pm »
STxAxTIC

I can't speak for others but as for me, I am following every word.  The code I posted is very
simple and all it does is this.  As the code is set now, it starts with the 4 most current entries
in the string, lets say 1001 for example, flow = right to left so the first 4 digits in the string.

Next it builds two search strings, Pat0$ and Pat1$.  Pat0$ = "0" + the first 4 digits 1001 and
Pat1$ = "1" + the first 4.

so Pat0$ = 01001 and Pat1$ = 11001

The program worms it's way through the entire string and every time it finds a match it counts
it, ie, Hit0 and Hit1 hold these counts.  Once it finishes the search it then increases the digits
taken from the main string by 1.  So the first cycle uses the first 4 digits in the string, the second
uses 5 and so on.  Both search patterns, ie, Pat0$ and Pat1$ are padded with a 0 or 1 to impose
the next prediction before it happens.  The next value update will equal one of the two search
patterns. 

The program does not reset the counters during the cycle phase.  The number of cycles can be set
to span any range but search strings with lengths of 5 to 7 seem to work best.  In the version I
used in my main program I was able to set the string length, the number of cycles, weights etc
as commented within the code.  These can be ignored, just placed there to indicate values that
can be adjusted.  Sometimes shorter string lengths work better but in my main tool the strings
can have as many as 5K entries.

The predictions are made based on if the counts for Pat1$ are >= the counts for Pat0$.  Very
simple tool.

Once it completes analysis on the string it then loads the next string and repeats the process. 

What it does in a sense, is it only uses the alphabets that coincide with the most recent events
of the string being analyzed, ie the first 4 to 6 plus a leading 0 or 1 to simulate the next event.

It's basically a brute force method that tries to find what happened's most often within the history.
I use the >= because (0's) often make up the majority of the string volume so anytime the total
ones reach or surpass the zero counts the prediction goes to 1.   The results in the posted code
store the predicted values in a array which is not needed here but is used within my program to
transfer predictions to the next stage in my main program.

Please don't think that I have left off working with your attempts, I have read the information
you provide in the link dozens of times.  I understand what your doing and hope you continue
working on it.  The strings I posted are just a subset of the total and a different method is used
in building these strings.  They are based on rather a value stays the same or changes.  Not a
big difference but they do seem to be more predictable.

The hardest thing for me in understanding and making edits to your code so that in fits into my
main program is the print stuff.  Not a biggie but every time you make changes I have to change
my edits also.  What I have done to deal with this until the final version is complete is to add the
load from file option, compile it then shell the program from my main program.  Makes keeping
up much easier.

In the end I hope to edit your code so that it fits seamlessly into my main program where the
only thing printed to screen are the progress bars.

I mentioned somewhere in the post the idea of using more than one prediction tool for each
string in hopes that combining outputs might give a more accurate prediction.  Sometimes
it's easier to built more than one tool to ease complexity and expand the final project.  I can't
begin to tell you the number of times a attempt got so complex I could not follow my own
code.     
 
Anyway,  Many thanks

R1

Offline random1

  • Newbie
  • Posts: 86
Re: Looking for old program or help recreating it
« Reply #84 on: December 23, 2021, 05:55:52 pm »

The below pic shows added counters for the number of incorrect predictions made overall.
If anyone is interested I will post the updated code. 

R1

https://i.postimg.cc/q7jZfNCQ/p1-ps.png

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
Re: Looking for old program or help recreating it
« Reply #85 on: December 24, 2021, 12:14:13 pm »
Yello r1,

I gave your program a closer look and your description really helped. Your method reminds me of a past thread - the stuff I was alluding to way back. Back a few pages ago when I was yelling for Steve and bplus to publicly remember working on a problem similar to this, it was because I remembered their solutions - and lo and behold - turns out yours is much like theirs. It'd say the algorithm you're using is viable for the question on hand, I've seen it work before for similar jobs.

What would be a fun exercise is to find the tuning in w(n)-space that makes my predictor say the same thing that yours does. And on that note, I can totally understand what you mean by saying my code has a whole mess of print statements and stuff. Let me peel that onion a little.

(I)
For anything to work at all, the "alphabets" arrays and the "weights" arrays must be defined. In cartoon code, this obviously looks like:

Code: QB64: [Select]
  1. Dim Shared Alphabet1(2) As LetterBin ' 0 1
  2. Dim Shared Alphabet2(4) As LetterBin ' 00 01 10 11
  3. Dim Shared Alphabet3(8) As LetterBin ' 000 001 010 011 100 101 110 111
  4. Dim Shared Alphabet4(16) As LetterBin ' etc.
  5. ...
  6. Alphabet1(1).Signature = "0"
  7. Alphabet1(2).Signature = "1"
  8. Call NewAlphabet(Alphabet1(), Alphabet2())
  9. Call NewAlphabet(Alphabet2(), Alphabet3())
  10. Call NewAlphabet(Alphabet3(), Alphabet4())
  11. ...
  12. Dim Shared AlphaWeight(1 To 13) As Double
  13.  

where weights are specified a few ways. My favorite being

Code: QB64: [Select]
  1. Call InitializeBinaryModel(BinaryModelIndex)

where BinaryModelIndex is an integer between 0 and 1023. This will convert to a 10-bit binary number that specifies w(n), as you already know.

(II)
Okay, with all that defined, it's ready for use. If you specify a sequence TheString = "00111011000011100100010100101" or whatever, all that's needed now is one function:

Analyze(TheString, AlphaWeight(), 0)

... but this is a function. So you want to print the output or store it in a varaible:

Code: QB64: [Select]
  1. GuessPredicted = Analyze(TheString, AlphaWeight(), 0)

Point is, all you do is specify is TheString, and Analyze gives you a 0 or a 1. Done and done. In my code, everything surrounding Analyze can be deleted - there need not be a main loop or anything else.

(III)

All that said, my actual code puts Analyze in like, 3 loops. This is because, in order to avoid version hell, I use one codebase that does every task in a unified way. Since that's becoming stable, I may shatter this finally into different files to keep it all more digestible. I'll in fact maybe do this - consider the ball still in my court.
« Last Edit: December 24, 2021, 01:26:58 pm by STxAxTIC »
You're not done when it works, you're done when it's right.

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
Re: Looking for old program or help recreating it
« Reply #86 on: December 24, 2021, 03:47:09 pm »
Hey R1,

Quick update on this... So I couldn't bring myself to fragment the code apart yet, I'm still a little busy making discoveries with it, so it's in research mode for the time being. One improvement I made is a way to load the data files you provide:

Code: QB64: [Select]
  1. ' Load test data from file or from sub.
  2.     ReDim _Preserve TestData(LoadTestFile(0, Command$(1), -1))
  3.     ReDim _Preserve TestData(LoadTestData(0))

The "-1" switch means the input string is stored backwards like your program prefers. I'll put the full code at the bottom. The way to use it right now: just compile the EXE and then drag+drop your file onto it. It will buzz through the whole thing swiftly, especially if you turn off the delays and limits. The model used is 0000101000 or something like that.

Some elaboration: There are two main loops in the program, (i) a routine that loops through each data sample while the model is fixed, or (ii) a routine that loops through each model while the sample is fixed. What is does *not* do so far is both at the same time. If all that is too crazy, fret not - Like I was saying, you can just delete around Analyze() until it's simple enough.

Speaking of simple enough, I want to look into turning your predictor into a function. That is, if I take your code, and insist on writing an analog to Analyze(), what does it look like? I'll spend a little while with it.

Code: QB64: [Select]
  1.  
  2. Screen _NewImage(120, 40)
  3.  
  4. ' Version: 22
  5.  
  6. Type LetterBin
  7.     Signature As String
  8.     Count As Integer
  9.  
  10. Dim Shared Alphabet1(2) As LetterBin ' 0 1
  11. Dim Shared Alphabet2(4) As LetterBin ' 00 01 10 11
  12. Dim Shared Alphabet3(8) As LetterBin ' 000 001 010 011 100 101 110 111
  13. Dim Shared Alphabet4(16) As LetterBin ' etc.
  14. Dim Shared Alphabet5(32) As LetterBin
  15. Dim Shared Alphabet6(64) As LetterBin
  16. Dim Shared Alphabet7(128) As LetterBin
  17. Dim Shared Alphabet8(256) As LetterBin
  18. Dim Shared Alphabet9(512) As LetterBin
  19. Dim Shared Alphabet10(1024) As LetterBin
  20. Dim Shared Alphabet11(2048) As LetterBin
  21. Dim Shared Alphabet12(4096) As LetterBin
  22. Dim Shared Alphabet13(8192) As LetterBin
  23.  
  24. Alphabet1(1).Signature = "0"
  25. Alphabet1(2).Signature = "1"
  26. Call NewAlphabet(Alphabet1(), Alphabet2())
  27. Call NewAlphabet(Alphabet2(), Alphabet3())
  28. Call NewAlphabet(Alphabet3(), Alphabet4())
  29. Call NewAlphabet(Alphabet4(), Alphabet5())
  30. Call NewAlphabet(Alphabet5(), Alphabet6())
  31. Call NewAlphabet(Alphabet6(), Alphabet7())
  32. Call NewAlphabet(Alphabet7(), Alphabet8())
  33. Call NewAlphabet(Alphabet8(), Alphabet9())
  34. Call NewAlphabet(Alphabet9(), Alphabet10())
  35. Call NewAlphabet(Alphabet10(), Alphabet11())
  36. Call NewAlphabet(Alphabet11(), Alphabet12())
  37. Call NewAlphabet(Alphabet12(), Alphabet13())
  38.  
  39. ' Specification of weight model.
  40. Dim Shared AlphaWeight(1 To 13) As Double
  41.  
  42. ' Array for test sequences.
  43. ReDim Shared TestData(10000) As String
  44.  
  45. ' Statistics and metrics:
  46. Dim GuessPredicted As Integer
  47. Dim GuessCorrect As Double
  48. Dim GuessTotal As Double
  49. Dim GuessRatioBest As Double
  50. Dim GuessStreak As Integer
  51. Dim GuessStreakMax As Integer
  52. Dim GuessStreakBest As Integer
  53. Dim Grade(10000, 2) As Double
  54. Dim BinaryModelIndex As Integer
  55. Dim BinaryModelBest As Integer
  56.  
  57. ' Working varaibles:
  58. Dim TheString As String
  59. Dim As Integer k, m, n
  60.  
  61. ' Load test data from file or from sub.
  62.     ReDim _Preserve TestData(LoadTestFile(0, Command$(1), -1))
  63.     ReDim _Preserve TestData(LoadTestData(0))
  64.  
  65. GuessRatioBest = 0
  66. GuessStreakBest = 0
  67.  
  68. ' This outter loop is for cycling through models.
  69. ' If models are manually set, this loop goes forever.
  70. BinaryModelIndex = -1
  71. Do While (BinaryModelIndex < 1024)
  72.  
  73.     '''
  74.     ' Automatic increment of model index number.
  75.     'BinaryModelIndex = BinaryModelIndex + 1
  76.     'Call InitializeIndexedModel(BinaryModelIndex)
  77.     '''
  78.  
  79.     '''
  80.     ' Manual setting of model number using one of two similar functions:
  81.     'Call InitializeIndexedModel(16)
  82.     Call InitializeBinaryModel("0000101000")
  83.     '''
  84.  
  85.     ' This enclosed loop is for looping through test strings.
  86.     For m = 1 To UBound(TestData)
  87.  
  88.         GuessPredicted = -1
  89.         GuessCorrect = 0
  90.         GuessTotal = 0
  91.         GuessStreak = 0
  92.         GuessStreakMax = 0
  93.  
  94.         ' This core loop goes through a test string at a rate of one bit per iteration.
  95.         ' For Gaming mode, this essentially becomes an infinite DO loop.
  96.         For n = 1 To Len(TestData(m)) '9999
  97.  
  98.             '''
  99.             ' Auto-feed Mode:
  100.             TheString = Left$(TestData(m), n)
  101.             '''
  102.  
  103.             '''
  104.             ' Gaming Mode:
  105.             'Call InitializeBinaryModel("0000101000")
  106.             'Cls
  107.             'Locate 1, 1
  108.             'Print "Press LEFT or RIGHT."
  109.             'k = 0
  110.             'Do: k = _KeyHit: Loop Until ((k = 19200) Or (k = 19712))
  111.             'Select Case k
  112.             '    Case 19200
  113.             '        TheString = TheString + "0"
  114.             '    Case 19712
  115.             '        TheString = TheString + "1"
  116.             'End Select
  117.             '_KeyClear
  118.             '''
  119.  
  120.             Cls
  121.             Color 7
  122.             Locate 1, 1
  123.             For k = 1 To _Width
  124.                 Print "_";
  125.             Next
  126.             Print "Model ("; _Trim$(Str$(BinaryModelIndex)); "):";
  127.             For k = 1 To 10 'UBound(AlphaWeight)
  128.                 Print AlphaWeight(k);
  129.             Next
  130.             Print
  131.             Print
  132.             Print "Sequence (length "; _Trim$(Str$(Len(TheString))); "):"
  133.             Print TheString;
  134.             Color 8
  135.             Print Right$(TestData(m), Len(TestData(m)) - n);
  136.             Color 7
  137.             Print
  138.  
  139.             ' Reconciliation
  140.             If (GuessPredicted <> -1) Then
  141.                 Print
  142.                 Print "I predicted "; _Trim$(Str$(GuessPredicted)); " and you typed "; Right$(TheString, 1); "."
  143.                 If (GuessPredicted = Val(Right$(TheString, 1))) Then
  144.                     Print "I am RIGHT this round."
  145.                     GuessCorrect = GuessCorrect + 1
  146.                     GuessStreak = GuessStreak + 1
  147.                     If (GuessStreak > GuessStreakMax) Then GuessStreakMax = GuessStreak
  148.                     Grade(n, 2) = 1
  149.                 Else
  150.                     Print "I am WRONG this round."
  151.                     GuessStreak = 0
  152.                     Grade(n, 2) = 0
  153.                 End If
  154.                 GuessTotal = GuessTotal + 1
  155.                 Grade(n, 1) = GuessCorrect / GuessTotal
  156.             End If
  157.  
  158.             If (GuessTotal > 0) Then
  159.                 Print
  160.                 Print "I'm on a "; _Trim$(Str$(GuessStreak)); "-round winning streak."
  161.                 Print "My best streak has been "; _Trim$(Str$(GuessStreakMax)); "."
  162.                 If (GuessTotal <> 0) Then
  163.                     Print "My correctness rate is "; _Trim$(Str$(Int(100 * GuessCorrect / GuessTotal))); "% in "; _Trim$(Str$(GuessTotal)); " guesses."
  164.                 End If
  165.             End If
  166.  
  167.             GuessPredicted = Analyze(TheString, AlphaWeight(), 0)
  168.  
  169.             Print
  170.             'Print "I have made a new prediction."
  171.             'Print "Press LEFT or RIGHT to test me."
  172.             'Print "The best performance has been model #"; _Trim$(Str$(BinaryModelBest)); ", rated "; _Trim$(Str$(Int(GuessRatioBest * 100))); "%, best streak of "; _Trim$(Str$(GuessStreakBest)); "."
  173.  
  174.             ' Draw bottom graph if there's enough room.
  175.             If (CsrLin <= 23) Then
  176.                 If (GuessTotal <> 0) Then
  177.                     Call PrintGraph(TheString, Grade())
  178.                 End If
  179.             End If
  180.  
  181.             _Display
  182.             _Delay .02
  183.             _Limit 240
  184.         Next
  185.  
  186.         If (GuessCorrect / GuessTotal > GuessRatioBest) Then
  187.             BinaryModelBest = BinaryModelIndex
  188.             GuessRatioBest = GuessCorrect / GuessTotal
  189.             GuessStreakBest = GuessStreakMax
  190.         End If
  191.  
  192.         _Delay 3
  193.     Next
  194.  
  195.  
  196.  
  197. Function Analyze (TheStringIn As String, arrweight() As Double, pswitch As Integer)
  198.     Dim TheReturn As Integer
  199.     Dim As Integer n
  200.     Dim As Double r, j, k
  201.     Dim StringPhase(UBound(arrweight)) As String
  202.     Dim Partialguess(LBound(arrweight) To UBound(arrweight), 2) As Double
  203.  
  204.     StringPhase(1) = TheStringIn
  205.     For n = 2 To UBound(StringPhase) ' Phase analysis.
  206.         StringPhase(n) = Right$(StringPhase(n - 1), Len(StringPhase(n - 1)) - 1) + Left$(StringPhase(n - 1), 1)
  207.     Next
  208.  
  209.     ' Initialize partial results.
  210.     For n = LBound(Partialguess) To UBound(Partialguess)
  211.         Partialguess(n, 1) = -999
  212.     Next
  213.  
  214.     If (pswitch = 1) Then
  215.         Print
  216.         For n = 1 To _Width
  217.             Print "-";
  218.         Next
  219.         Print
  220.     End If
  221.  
  222.     If (arrweight(1) <> 0) Then Call CreateHisto(StringPhase(), 1, Alphabet1())
  223.     If (arrweight(2) <> 0) Then Call CreateHisto(StringPhase(), 2, Alphabet2())
  224.     If (arrweight(3) <> 0) Then Call CreateHisto(StringPhase(), 3, Alphabet3())
  225.     If (arrweight(4) <> 0) Then Call CreateHisto(StringPhase(), 4, Alphabet4())
  226.     If (arrweight(5) <> 0) Then Call CreateHisto(StringPhase(), 5, Alphabet5())
  227.     If (arrweight(6) <> 0) Then Call CreateHisto(StringPhase(), 6, Alphabet6())
  228.     If (arrweight(7) <> 0) Then Call CreateHisto(StringPhase(), 7, Alphabet7())
  229.     If (arrweight(8) <> 0) Then Call CreateHisto(StringPhase(), 8, Alphabet8())
  230.     If (arrweight(9) <> 0) Then Call CreateHisto(StringPhase(), 9, Alphabet9())
  231.     If (arrweight(10) <> 0) Then Call CreateHisto(StringPhase(), 10, Alphabet10())
  232.     If (arrweight(11) <> 0) Then Call CreateHisto(StringPhase(), 11, Alphabet11())
  233.     If (arrweight(12) <> 0) Then Call CreateHisto(StringPhase(), 12, Alphabet12())
  234.     If (arrweight(13) <> 0) Then Call CreateHisto(StringPhase(), 13, Alphabet13())
  235.  
  236.     If (pswitch = 1) Then ' Set the last argument >=1 to print stats for that histogram.
  237.         If ((Len(TheStringIn) >= 1) And (arrweight(1) <> 0)) Then Call PrintHisto(Alphabet1(), 0)
  238.         If ((Len(TheStringIn) >= 2) And (arrweight(2) <> 0)) Then Call PrintHisto(Alphabet2(), 0)
  239.         If ((Len(TheStringIn) >= 3) And (arrweight(3) <> 0)) Then Call PrintHisto(Alphabet3(), 0)
  240.         If ((Len(TheStringIn) >= 4) And (arrweight(4) <> 0)) Then Call PrintHisto(Alphabet4(), 0)
  241.         If ((Len(TheStringIn) >= 5) And (arrweight(5) <> 0)) Then Call PrintHisto(Alphabet5(), 4)
  242.         If ((Len(TheStringIn) >= 6) And (arrweight(6) <> 0)) Then Call PrintHisto(Alphabet6(), 0)
  243.         If ((Len(TheStringIn) >= 7) And (arrweight(7) <> 0)) Then Call PrintHisto(Alphabet7(), 0)
  244.         If ((Len(TheStringIn) >= 8) And (arrweight(8) <> 0)) Then Call PrintHisto(Alphabet8(), 0)
  245.         If ((Len(TheStringIn) >= 9) And (arrweight(9) <> 0)) Then Call PrintHisto(Alphabet9(), 0)
  246.         If ((Len(TheStringIn) >= 10) And (arrweight(10) <> 0)) Then Call PrintHisto(Alphabet10(), 0)
  247.         If ((Len(TheStringIn) >= 11) And (arrweight(11) <> 0)) Then Call PrintHisto(Alphabet11(), 0)
  248.         If ((Len(TheStringIn) >= 12) And (arrweight(12) <> 0)) Then Call PrintHisto(Alphabet12(), 0)
  249.         If ((Len(TheStringIn) >= 13) And (arrweight(13) <> 0)) Then Call PrintHisto(Alphabet13(), 0)
  250.         Print
  251.     End If
  252.  
  253.     ' Set the last argument =1 to print guess for that histogram.
  254.     If ((Len(TheStringIn) >= 1) And (arrweight(1) <> 0)) Then Call MakeGuess(TheStringIn, 1, Alphabet1(), Partialguess(), 0)
  255.     If ((Len(TheStringIn) >= 2) And (arrweight(2) <> 0)) Then Call MakeGuess(TheStringIn, 2, Alphabet2(), Partialguess(), 0)
  256.     If ((Len(TheStringIn) >= 3) And (arrweight(3) <> 0)) Then Call MakeGuess(TheStringIn, 3, Alphabet3(), Partialguess(), 0)
  257.     If ((Len(TheStringIn) >= 4) And (arrweight(4) <> 0)) Then Call MakeGuess(TheStringIn, 4, Alphabet4(), Partialguess(), 0)
  258.     If ((Len(TheStringIn) >= 5) And (arrweight(5) <> 0)) Then Call MakeGuess(TheStringIn, 5, Alphabet5(), Partialguess(), pswitch)
  259.     If ((Len(TheStringIn) >= 6) And (arrweight(6) <> 0)) Then Call MakeGuess(TheStringIn, 6, Alphabet6(), Partialguess(), 0)
  260.     If ((Len(TheStringIn) >= 7) And (arrweight(7) <> 0)) Then Call MakeGuess(TheStringIn, 7, Alphabet7(), Partialguess(), 0)
  261.     If ((Len(TheStringIn) >= 8) And (arrweight(8) <> 0)) Then Call MakeGuess(TheStringIn, 8, Alphabet8(), Partialguess(), 0)
  262.     If ((Len(TheStringIn) >= 9) And (arrweight(9) <> 0)) Then Call MakeGuess(TheStringIn, 9, Alphabet9(), Partialguess(), 0)
  263.     If ((Len(TheStringIn) >= 10) And (arrweight(10) <> 0)) Then Call MakeGuess(TheStringIn, 10, Alphabet10(), Partialguess(), 0)
  264.     If ((Len(TheStringIn) >= 11) And (arrweight(11) <> 0)) Then Call MakeGuess(TheStringIn, 11, Alphabet11(), Partialguess(), 0)
  265.     If ((Len(TheStringIn) >= 12) And (arrweight(12) <> 0)) Then Call MakeGuess(TheStringIn, 12, Alphabet12(), Partialguess(), 0)
  266.     If ((Len(TheStringIn) >= 13) And (arrweight(13) <> 0)) Then Call MakeGuess(TheStringIn, 13, Alphabet13(), Partialguess(), 0)
  267.     If (pswitch = 1) Then Print
  268.  
  269.     If (pswitch = 1) Then
  270.         Print "Thinking:   ";
  271.         For k = LBound(Partialguess) To UBound(Partialguess)
  272.             If (Partialguess(k, 1) <> -999) Then
  273.                 Print Partialguess(k, 1);
  274.             Else
  275.                 Print "_ ";
  276.             End If
  277.         Next
  278.         Print
  279.     End If
  280.  
  281.     j = 0
  282.     r = 0
  283.  
  284.     ' Weighted average calculation
  285.     For k = UBound(Partialguess) To LBound(Partialguess) Step -1
  286.         If (Partialguess(k, 1) <> -999) Then
  287.             r = r + arrweight(k) * Partialguess(k, 1)
  288.             j = j + arrweight(k)
  289.         End If
  290.     Next
  291.     If (j <> 0) Then
  292.         r = r / j
  293.     End If
  294.  
  295.     If (pswitch = 1) Then Print "Predicting:  "; _Trim$(Str$(r))
  296.  
  297.     If (r > .5) Then
  298.         r = 1
  299.     Else
  300.         r = 0
  301.     End If
  302.  
  303.     If (pswitch = 1) Then
  304.         Print "Rounding to: "; _Trim$(Str$(r))
  305.     End If
  306.  
  307.     If (pswitch = 1) Then
  308.         For n = 1 To _Width
  309.             Print "-";
  310.         Next
  311.         Print
  312.     End If
  313.  
  314.     TheReturn = r
  315.     Analyze = TheReturn
  316.  
  317. Sub MakeGuess (TheStringIn As String, wid As Integer, arralpha() As LetterBin, arrguess() As Double, pswitch As Integer)
  318.     Dim TheReturn As Double
  319.     Dim As Integer j, k, n
  320.     TheReturn = 0
  321.     j = 1
  322.     k = 0
  323.     For n = 1 To UBound(arralpha)
  324.         If (Left$(arralpha(n).Signature, wid - 1) = Right$(TheStringIn, wid - 1)) Then
  325.             If (arralpha(n).Count >= j) Then
  326.                 If (pswitch = 1) Then Print "Order-"; Right$("0" + _Trim$(Str$(wid)), 2); " guess: "; arralpha(n).Signature; " . "; _Trim$(Str$(arralpha(n).Count))
  327.                 TheReturn = TheReturn + Val(Right$(arralpha(n).Signature, 1))
  328.                 k = k + 1
  329.                 j = arralpha(n).Count
  330.             End If
  331.         End If
  332.     Next
  333.     If (k <> 0) Then
  334.         TheReturn = TheReturn / k
  335.     Else
  336.         TheReturn = .5
  337.     End If
  338.     arrguess(wid, 1) = TheReturn
  339.     arrguess(wid, 2) = j
  340.  
  341. Sub InitializeIndexedModel (TheIndexIn As Integer)
  342.     '0 to 1023
  343.     Call InitializeBinaryModel(BIN$(TheIndexIn))
  344.  
  345. Sub InitializeBinaryModel (Weights As String)
  346.     Dim As Integer k
  347.     If (Weights = "-1") Then
  348.         For k = LBound(AlphaWeight) To UBound(AlphaWeight)
  349.             AlphaWeight(k) = k ^ 2
  350.         Next
  351.     Else
  352.         For k = 1 To 10
  353.             AlphaWeight(k) = Val(Mid$(Weights, k, 1))
  354.         Next
  355.         AlphaWeight(11) = 0
  356.         AlphaWeight(12) = 0
  357.         AlphaWeight(13) = 0
  358.     End If
  359.  
  360.     ' Taken from the Wiki. Ugliest function ever.
  361.     Dim As Integer max, i, msb
  362.     Dim As String b
  363.     max% = 8 * Len(n%) ': MSB% = 1   'uncomment for 16 (32 or 64) bit returns
  364.     For i = max% - 1 To 0 Step -1 'read as big-endian MSB to LSB
  365.         If (n% And 2 ^ i) Then msb% = 1: b$ = b$ + "1" Else If msb% Then b$ = b$ + "0"
  366.     Next
  367.     b$ = "0000000000" + b$
  368.     b$ = Right$(b$, 10)
  369.     If b$ = "" Then BIN$ = "0" Else BIN$ = b$ 'check for empty string
  370.  
  371. Sub CreateHisto (arrseqphase() As String, wid As Integer, arralpha() As LetterBin)
  372.     Dim As Integer j, k, n
  373.     For n = 1 To UBound(arralpha)
  374.         arralpha(n).Count = 0
  375.     Next
  376.     ' Uncomment this loop to enable phase analysis.
  377.     ' Hack j=1 to use base string only.
  378.     For j = 1 To 1 'wid
  379.         For k = 1 To Len(arrseqphase(j)) - (Len(arrseqphase(j)) Mod wid) Step wid
  380.             For n = 1 To UBound(arralpha)
  381.                 If (Mid$(arrseqphase(j), k, wid) = arralpha(n).Signature) Then
  382.                     arralpha(n).Count = arralpha(n).Count + 1
  383.                 End If
  384.             Next
  385.         Next
  386.     Next
  387.     Call QuickSort(arralpha(), 1, UBound(arralpha))
  388.  
  389. Sub PrintHisto (arr() As LetterBin, wid As Integer)
  390.     Dim As Integer j, n
  391.     If (wid > 0) Then
  392.         If (wid > UBound(arr)) Then
  393.             j = UBound(arr)
  394.         Else
  395.             j = wid
  396.         End If
  397.         Print "Histogram: "; _Trim$(Str$(UBound(arr))); "-letter regroup, showing top "; _Trim$(Str$(wid))
  398.         For n = 1 To j
  399.             Print arr(n).Signature; arr(n).Count
  400.         Next
  401.     End If
  402.  
  403. Sub PrintGraph (TheString As String, arrgrade() As Double)
  404.     Dim As Integer j, k
  405.     Dim As Double f, g
  406.     For k = 1 To _Width
  407.         Locate _Height - 5, k: Print "_"
  408.         Locate _Height - 5 - 10, k: Print "_"
  409.     Next
  410.     Locate _Height - 5 + 1, 1: Print "0%"
  411.     Locate _Height - 5 - 10 - 1, 1: Print "100%"
  412.     f = (_Width) / Len(TheString)
  413.     If (f > 1) Then f = 1
  414.     For j = 2 To Len(TheString)
  415.         g = Int(j * f)
  416.         If (g = 0) Then g = 1
  417.         Locate _Height - 5 - Int(10 * arrgrade(j, 1)), g
  418.         If (arrgrade(j, 2) = 1) Then
  419.             Print Chr$(251)
  420.         Else
  421.             Print "x"
  422.         End If
  423.     Next
  424.  
  425. Sub NewAlphabet (arrold() As LetterBin, arrnew() As LetterBin)
  426.     Dim As Integer j, k, n
  427.     n = 0
  428.     For k = 1 To 2
  429.         For j = 1 To UBound(arrold)
  430.             n = n + 1
  431.             arrnew(n).Signature = arrold(j).Signature
  432.         Next
  433.     Next
  434.     For j = 1 To UBound(arrnew)
  435.         If (j <= UBound(arrnew) / 2) Then
  436.             arrnew(j).Signature = "0" + arrnew(j).Signature
  437.         Else
  438.             arrnew(j).Signature = "1" + arrnew(j).Signature
  439.         End If
  440.     Next
  441.  
  442. Sub QuickSort (arr() As LetterBin, LowLimit As Long, HighLimit As Long)
  443.     Dim As Long piv
  444.     If (LowLimit < HighLimit) Then
  445.         piv = Partition(arr(), LowLimit, HighLimit)
  446.         Call QuickSort(arr(), LowLimit, piv - 1)
  447.         Call QuickSort(arr(), piv + 1, HighLimit)
  448.     End If
  449.  
  450. Function Partition (arr() As LetterBin, LowLimit As Long, HighLimit As Long)
  451.     Dim As Long i, j
  452.     Dim As Double pivot, tmp
  453.     pivot = arr(HighLimit).Count
  454.     i = LowLimit - 1
  455.     For j = LowLimit To HighLimit - 1
  456.         tmp = arr(j).Count - pivot
  457.         If (tmp >= 0) Then
  458.             i = i + 1
  459.             Swap arr(i), arr(j)
  460.         End If
  461.     Next
  462.     Swap arr(i + 1), arr(HighLimit)
  463.     Partition = i + 1
  464.  
  465. Function Pathological$ (TheSeed As String, TheLength As Integer)
  466.     Dim TheReturn As String
  467.     TheReturn = TheSeed
  468.     Dim p
  469.     Do
  470.         p = Analyze(TheReturn, AlphaWeight(), 0)
  471.         If (p = 1) Then
  472.             TheReturn = TheReturn + "0"
  473.         Else
  474.             TheReturn = TheReturn + "1"
  475.         End If
  476.     Loop Until Len(TheReturn) = TheLength
  477.     Pathological$ = TheReturn
  478.  
  479. Function LoadTestFile (alwayszero As Integer, TheFile As String, ReversalToggle As Integer)
  480.     Dim As Integer j, k
  481.     Dim n As Integer
  482.     Dim a As String
  483.     n = alwayszero
  484.     Open TheFile For Input As #1
  485.     Do While Not EOF(1)
  486.         n = n + 1
  487.         Line Input #1, a
  488.         TestData(n) = a
  489.     Loop
  490.     Close #1
  491.     If (ReversalToggle = -1) Then
  492.         For k = 1 To n
  493.             a = TestData(k)
  494.             TestData(k) = ""
  495.             For j = Len(a) To 1 Step -1
  496.                 TestData(k) = TestData(k) + Mid$(a, j, 1)
  497.             Next
  498.         Next
  499.     End If
  500.     LoadTestFile = n
  501.  
  502. Function LoadTestData (alwayszero As Integer)
  503.     Dim n As Integer
  504.     n = alwayszero
  505.  
  506.     '''
  507.     ' Percussive cases:
  508.     '''
  509.     n = n + 1: TestData(n) = "1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111"
  510.     n = n + 1: TestData(n) = "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
  511.     n = n + 1: TestData(n) = "0101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101"
  512.     n = n + 1: TestData(n) = "1010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010"
  513.     n = n + 1: TestData(n) = "0001110011000111001100011100110001110011000111001100011100110001110011000111001100011100110001110011000111001100011100110001110011000111001100011100110001110011"
  514.     n = n + 1: TestData(n) = "0100010111010001011101000101110100010111010001011101000101110100010111010001011101000101110100010111010001011101000101110100010111010001011101000101110100010111"
  515.  
  516.     '''
  517.     ' Human samples:
  518.     '''
  519.     ' (from Keybone)
  520.     n = n + 1: TestData(n) = "101010101010101010101001010101010101001010111001010101010101010101010100010101010101010100101001010101001100101010001010100101010100101010100101010101010101010011011110010101010100100101010110010011001010011001010100010100101010010101010101010010101010101010010101001010101010100110010101010100101010101010011001001010100101010010101010100101010010101001010100101001010010101010111010100110011001010101010100110101001010101010100101001010111010101010101010100101001010101010010101010101001010101001010101001010100101010100101010010101010101001010101001010101010101001010101001010100101010101010010101010010010101010101010101010010100101010101001010100101001010101001111101010101010100101010110011001010101010101010110101010101101010101010100101010010101010010101010101101110010101001010101010110010100101010101001011010101010100110101010100101010010101010100101010101001010101010101001010101010011010101010101110110100101010111010101011011001011001010101001010101010101010101010011001010101010100101010101010101010010100101"
  521.     ' (from Keybone)
  522.     n = n + 1: TestData(n) = "0101110101100011010100101011001110001011001010001110101111010100111011100100101001010011110101101000101010001010101111001010111010101010100001010101000101101100101111101010010101110110111001000101000011010101010001001001001111101011101010100010110101110101100000101010101110111010100100100001110111100101011110101010001010001110010110111110110010101001001011101000101001011100011101000010101010101101010010110100101101000101111010101110111001010011101111010101000010101111100010101011110101011011110100001010110"
  523.     ' (from Loudar)
  524.     n = n + 1: TestData(n) = "1011001010010100100100110010101010101001010101010101011010010101001010101001010010100110101011010101010101011010101101010101010101010010110101010101100101010101010110101101011010010101010010100110101101001010110101011010010101101010110100101111010101010011011011010010110101010010110100101101010100101011010010101001010101010001011101011010010101011100111010010001101011110010011010001011100110101010010011010101001001010010000101010110001"
  525.     ' (from Luke)
  526.     n = n + 1: TestData(n) = "01100101001010001100001101101111011010010101010110110101001000001111001111110101000101111011010101111101010101101010101001010101011000010101010101001011010100110100110100110011010101010101110101010111111101011010100000001101111000010111000110111001000010100001101010110100000111101011111100001011001010110010110"
  527.     ' (from Sarafromct)
  528.     n = n + 1: TestData(n) = "10101010101011101000011101010111010101010101100111001010100111100001011011110101000001111010101101010000001111110011111110111101110111001110110010000100010101010101010100101011010110101010101010101001000000001111110000011110101010101010100010101110101010101101111111111111111111101010101010101000000"
  529.     ' (from Spriggs)
  530.     n = n + 1: TestData(n) = "10111010101010101010101001010101010101001010101001010101010101010101010101010101010101010101010101010101001010100100100101010101010101001010100101010101010100101010100101010101010101010101001010010110010101010010101010101010101010101010100101001001001010101010101010101010101001010101001001101010010"
  531.     ' (from Spriggs)
  532.     n = n + 1: TestData(n) = "11111011110100101011111111110100000011011110101100111100111111110111101110100111100110011111110101111111010111101111100111110111111111111011100111110111111110010000101011111001110101101010110111110"
  533.     ' (from Hotpants)
  534.     n = n + 1: TestData(n) = "01010100011001010010101010101010101000110101010111101010100100011010101010100100101110010010010100001010101001010101010110010001001011000100100110101001001001010000000001010101101111101001010100010101001001010101000100101001100100010011010101010101010111010010101011101011011010110100100010010100100100010010001001"
  535.  
  536.     '''
  537.     ' Noted sequences:
  538.     '''
  539.     ' (Wolfram rule 30)
  540.     n = n + 1: TestData(n) = "110111001100010110010011101011100111010101100001100101011010101111110000111100010101110000010010110001110001101101101000000010001111101110100111000111010111000001100100011001111001111110000001111111011001011011100000101100011011000110001110110110010101111111011010110110111101110010111011000100000000001101110010110010111100100110000111110000001011011001111001000010011111000001101001011001001011101011000001101001000101001011101011111011000100000011110101000111101001011010001101000111100001000011110001111010"
  541.  
  542.     LoadTestData = n
  543.  
  544. ''' Museum:
  545. 'Call InitializeIndexedModel(BinaryModelIndex) ' Goes with counter
  546. 'Call InitializeIndexedModel(0)                ' Always zero
  547. 'Call InitializeIndexedModel(1023)             ' Homogeneous
  548. 'Call InitializeIndexedModel(16)               ' This 5-gram case (16) works best for Gaming mode.
  549. 'Call InitializeIndexedModel(82)               ' Learning algo discoverd this is a good one against humans.
  550. 'Call InitializeIndexedModel(18)               ' Learning algo discoverd this is a good one against humans.
  551. 'Call InitializeBinaryModel(-1)               ' Enables custom models.
  552. '''
  553.  
  554. '''
  555. ' Studies in pathology:
  556. 'BinaryModelIndex = 2   ' cracked by 124       0000000010 0001111100
  557. 'BinaryModelIndex = 3   ' cracked by 16        0000000011 0000010000
  558. 'BinaryModelIndex = 4   ' cracked by 265       0000000100 0100001001
  559. 'BinaryModelIndex = 5   ' cracked by 736       0000000101 1011100000
  560. 'BinaryModelIndex = 6   ' cracked by 49        0000000110 0000110001
  561. 'BinaryModelIndex = 7   ' cracked by 88        0000000111 0001011000
  562. 'BinaryModelIndex = 8   ' cracked by xxx       0000001000 lambda=16
  563. 'BinaryModelIndex = 9   ' cracked by xxx       0000001001 xxx
  564. 'BinaryModelIndex = 10  ' cracked by 644       0000001010 1010000100
  565. 'BinaryModelIndex = 11  ' cracked by 261       0000001011 0100000101
  566. '''
  567.  
You're not done when it works, you're done when it's right.

Offline random1

  • Newbie
  • Posts: 86
Re: Looking for old program or help recreating it
« Reply #87 on: December 24, 2021, 05:53:09 pm »
STxAxTIC

I think were going to need a smarter more inclusive method to reach the level of prediction
I need to call it a success.  The project thus far has already surpassed my expectations but
it seems the goal post has been moved.  Maybe chasing such expectations will turn into a
fool's errand but I can't stop thinking it's achievable.

I have a old predictor, even older then the dummy tool I posted earlier.  I will try to explain
it and maybe it will spark your interest.  It often averaged over 80% overall but I hit a wall so
to say and I was never able to improve it past a certain point.  Here is a rundown on how it
worked.

1st.  Count the overall number of 0's and 1's within the string being processed and calculate
        a hit ratio for both 0 and 1.
     
2nd.  Set a search string length, normally around 6 to 15 but could be much larger if needed.

3rd. Generate a random value between 1 and Len(dat1$), ie, of main string.

4th. A sample is then collected starting at rng value and extending to the length set in step 2

5th. Do a simple count for both 0's and 1's within the randomly collected sample.

6th.  A ratio is then calculated for the random sample.  This ratio is compared against the full
       string ratio and averaged to give a means to calculate the final guess in the 8th, 9th steps.

7th.  The program would be set to collect around 350 to 500 of these samples before making
        the guess / prediction. 

8th. The final step would be to count starting with the leftmost digit in the string to the value
       set in step 2 minus 1.  If the value in step 2 is set to 15 then count the first 14 as we will
       be adding either a 0 or a 1 in the final prediction.

9th.  The guess is made by first adding a digit 0 to the 14 and seeing how well it matches the
        overall ratio and the samples ratio.  Then do the same thing and replace the added 0 with
        a 1 and check again.       

The idea is to first get the ratios for the overall and the random samples, then apply those ratios
to the 14 most current list of digits in the main string.  Lets say the overall sample is something
like 35/65 and the random samples produce a ratio of 40/60 and the counts for the last 14 events
equals something like 33/67. This is then used to make the final guess /prediction.

The random samples give us a good understanding of how many times each digit should appear
within a certain length of sample size.  This is where I got stuck as a simple average is not enough
to make a good prediction.  Maybe creating a lower/upper threshold would add a fine tuning element
to the mix.

Anyway I was thinking you might be able to tinker with it by adding running averages, weights etc
to improve the overall accuracy.  I can post or attach the cartoon code if your interested. 

P.S.
This will be my last post until maybe Monday evening, family coming for Christmas.

Thanks again

R1 
   


Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
Re: Looking for old program or help recreating it
« Reply #88 on: December 28, 2021, 12:16:45 pm »
Hey R1

Hope Christmas wasn't too exhausting! I just re-skimmed your nicely-detailed list of steps above, and I think I know what you were getting at. In fact, in some form or another, it sounds a lot like what I'm doing in some places. The way you make the final prediction by asking (qualitatively) "which familiar pattern was the sequence almost finished making?" is exactly what I do. The way we get to that question of course is different. (Insert all that "alphabet" mumbo jumbo I use.)

The reason I break radio silence today is to show a systematic way of improving correctness rates, plus show a few numbers. It's all about fitting the best model to the data, like ordinary curve fitting, but we're stepping through binary models. For every sample sequence tested, this new "stepping" method finds a better model than the one(s) we were assuming by hand. It's definitely a proof that the machine is always more precise than the person when it comes to looking for patterns, haha.

This new kind of analysis completes a good circuit in computation space. The final guess is informed by (i) patterns across all frequencies (alphabet sizes) from 1 to any limit, (ii) all possible ways of guessing the answer, assuming binary models. One next branch of research is nonbinary models, letting w(n) vary as some kind of function. This would be a brain-exploding amount of work to do *perfectly* right, but it can be messed with kinda easily. I drafted (in my usual non-spellchecked Notepad style) to demonstrate things. (Still incomplete but nontrivial.) http://barnes.x10host.com/pages/Binary-Analyzer/Binary-Analyzer-Two.php

Just to get back on a familiar track, are there any (new or old) test strings you have in mind that are particularly hard to crack?




Code as of now:

Code: QB64: [Select]
  1.  
  2. _Title "Binary Analyzer"
  3.  
  4. Screen _NewImage(120, 40)
  5.  
  6. ' Version: 22
  7.  
  8. Type LetterBin
  9.     Signature As String
  10.     Count As Integer
  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. ' Specification of weight model.
  42. Dim Shared AlphaWeight(1 To 13) As Double
  43.  
  44. ' Array for test sequences.
  45. ReDim Shared TestData(256 ^ 2) As String
  46.  
  47. ' Statistics and metrics:
  48. Dim GuessPredicted As Integer
  49. Dim GuessCorrect As Double
  50. Dim GuessTotal As Double
  51. Dim GuessRatioBest As Double
  52. Dim GuessRatioWorst As Double
  53. Dim GuessStreak As Integer
  54. Dim GuessStreakMax As Integer
  55. Dim GuessStreakBest As Integer
  56. Dim Grade(256 ^ 2, 2) As Double
  57. Dim BinaryModelIndex As Integer
  58. Dim BinaryModelBest As Integer
  59. Dim BinaryModelWorst As Integer
  60.  
  61. ' Working varaibles:
  62. Dim TheString As String
  63. Dim As Integer k, m, n
  64.  
  65. ' Load test data from file or from sub.
  66.     ReDim _Preserve TestData(LoadTestFile(0, Command$(1), -1))
  67.     ReDim _Preserve TestData(LoadTestData(0))
  68.  
  69. GuessRatioBest = 0
  70. GuessRatioWorst = 1
  71. GuessStreakBest = 0
  72. BinaryModelWorst = 1
  73.  
  74. '''
  75. ' Play area:
  76. 'Call InitializeModelLiteral("0010101000")
  77. 'Call InitializeModelCustom("-1")
  78. 'Call InitializeModelIndexed(84)
  79. 'TestData(1) = Pathological$("1", 1000)
  80. 'TestData(1) = QBPRNG$(Timer, 1000)
  81. n = 1: TestData(n) = "1011001010010100100100110010101010101001010101010101011010010101001010101001010010100110101011010101010101011010101101010101010101010010110101010101100101010101010110101101011010010101010010100110101101001010110101011010010101101010110100101111010101010011011011010010110101010010110100101101010100101011010010101001010101010001011101011010010101011100111010010001101011110010011010001011100110101010010011010101001001010010000101010110001"
  82. ReDim _Preserve TestData(1)
  83. 'Open "output.txt" For Output As #1
  84. 'Print #1, TestData(1)
  85. 'Close #1
  86. '''
  87.  
  88. ' This outer loop is for cycling through models.
  89. ' If models are manually set, this loop goes forever.
  90. BinaryModelIndex = -1
  91. Do While (BinaryModelIndex < 1024)
  92.  
  93.     '''
  94.     ' Automatic increment of model index number.
  95.     BinaryModelIndex = BinaryModelIndex + 1
  96.     Call InitializeModelIndexed(BinaryModelIndex)
  97.     '''
  98.  
  99.     '''
  100.     ' Manual setting of model number using either of two similar functions:
  101.     'Call InitializeModelIndexed(16)
  102.     'Call InitializeModelLiteral("0010100000")
  103.     'Call InitializeModelCustom("-1")
  104.     '''
  105.  
  106.     ' This enclosed loop is for looping through test strings.
  107.     For m = 1 To UBound(TestData)
  108.  
  109.         GuessPredicted = -1
  110.         GuessCorrect = 0
  111.         GuessTotal = 0
  112.         GuessStreak = 0
  113.         GuessStreakMax = 0
  114.  
  115.         ' This core loop goes through a test string at a rate of one bit per iteration.
  116.         ' For Gaming mode, this essentially becomes an infinite DO loop.
  117.         For n = 1 To Len(TestData(m)) '9999
  118.  
  119.             '''
  120.             ' Auto-feed Mode:
  121.             TheString = Left$(TestData(m), n)
  122.             '''
  123.  
  124.             '''
  125.             ' Gaming Mode:
  126.             'Call InitializeModelLiteral("0000101000")
  127.             'Cls
  128.             'Locate 1, 1
  129.             'Print "Press LEFT or RIGHT."
  130.             'k = 0
  131.             'Do: k = _KeyHit: Loop Until ((k = 19200) Or (k = 19712))
  132.             'Select Case k
  133.             '    Case 19200
  134.             '        TheString = TheString + "0"
  135.             '    Case 19712
  136.             '        TheString = TheString + "1"
  137.             'End Select
  138.             '_KeyClear
  139.             '''
  140.  
  141.             Cls
  142.             Color 7
  143.             Locate 1, 1
  144.             For k = 1 To _Width
  145.                 Print "_";
  146.             Next
  147.             Print "Model ("; _Trim$(Str$(BinaryModelIndex)); "):";
  148.             For k = 1 To 10 'UBound(AlphaWeight)
  149.                 Print AlphaWeight(k);
  150.             Next
  151.             Print
  152.             Print
  153.             Print "Sequence (length "; _Trim$(Str$(Len(TheString))); "):"
  154.             Print Right$(TheString, 400);
  155.             Color 8
  156.             Print Left$(Right$(TestData(m), Len(TestData(m)) - n), 400);
  157.             Color 7
  158.             Print
  159.  
  160.             ' Reconciliation
  161.             If (GuessPredicted <> -1) Then
  162.                 Print
  163.                 Print "I predicted "; _Trim$(Str$(GuessPredicted)); " and you typed "; Right$(TheString, 1); "."
  164.                 If (GuessPredicted = Val(Right$(TheString, 1))) Then
  165.                     Print "I am RIGHT this round."
  166.                     GuessCorrect = GuessCorrect + 1
  167.                     GuessStreak = GuessStreak + 1
  168.                     If (GuessStreak > GuessStreakMax) Then GuessStreakMax = GuessStreak
  169.                     Grade(n, 2) = 1
  170.                 Else
  171.                     Print "I am WRONG this round."
  172.                     GuessStreak = 0
  173.                     Grade(n, 2) = 0
  174.                 End If
  175.                 GuessTotal = GuessTotal + 1
  176.                 Grade(n, 1) = GuessCorrect / GuessTotal
  177.             End If
  178.  
  179.             If (GuessTotal > 0) Then
  180.                 Print
  181.                 Print "I'm on a "; _Trim$(Str$(GuessStreak)); "-round winning streak."
  182.                 Print "My best streak has been "; _Trim$(Str$(GuessStreakMax)); "."
  183.                 If (GuessTotal <> 0) Then
  184.                     Print "My correctness rate is "; _Trim$(Str$(Int(100 * GuessCorrect / GuessTotal))); "% in "; _Trim$(Str$(GuessTotal)); " trials."
  185.                 End If
  186.             End If
  187.  
  188.             GuessPredicted = Analyze(TheString, AlphaWeight(), 0)
  189.  
  190.             '''
  191.             ' Reverse polarity if needed for any reason.
  192.             'If (GuessPredicted = 0) Then
  193.             '    GuessPredicted = 1
  194.             'Else
  195.             '    GuessPredicted = 0
  196.             'End If
  197.             '''
  198.  
  199.             Print
  200.             'Print "I have made a new prediction."
  201.             'Print "Press LEFT or RIGHT to test me."
  202.             Print "The best performance has been model #"; _Trim$(Str$(BinaryModelBest)); ", rated "; _Trim$(Str$(Int(GuessRatioBest * 100))); "%, best streak of "; _Trim$(Str$(GuessStreakBest)); "."
  203.             Print "The worst performance has been model #"; _Trim$(Str$(BinaryModelWorst)); ", rated "; _Trim$(Str$(Int(GuessRatioWorst * 100))); "%."
  204.  
  205.             ' Draw bottom graph if there's enough room.
  206.             If (CsrLin <= 23) Then
  207.                 If (GuessTotal <> 0) Then
  208.                     Call PrintGraph(TheString, Grade())
  209.                 End If
  210.             End If
  211.  
  212.             _Display
  213.             _Delay .02
  214.             _Limit 240
  215.         Next
  216.  
  217.         If (GuessTotal > 0) Then
  218.             If (GuessCorrect / GuessTotal >= GuessRatioBest) Then
  219.                 BinaryModelBest = BinaryModelIndex
  220.                 GuessRatioBest = GuessCorrect / GuessTotal
  221.                 GuessStreakBest = GuessStreakMax
  222.                 'Open "output.txt" For Append As #1
  223.                 'Print #1, BinaryModelBest, GuessRatioBest, GuessStreakBest
  224.                 'Close #1
  225.             End If
  226.             If (GuessCorrect / GuessTotal <= GuessRatioWorst) Then
  227.                 BinaryModelWorst = BinaryModelIndex
  228.                 GuessRatioWorst = GuessCorrect / GuessTotal
  229.             End If
  230.  
  231.         End If
  232.  
  233.         _Delay 3
  234.     Next
  235.  
  236.  
  237.  
  238. Function Analyze (TheStringIn As String, arrweight() As Double, pswitch As Integer)
  239.     Dim TheReturn As Integer
  240.     Dim As Integer n
  241.     Dim As Double r, j, k
  242.     Dim StringPhase(UBound(arrweight)) As String
  243.     Dim Partialguess(LBound(arrweight) To UBound(arrweight), 2) As Double
  244.  
  245.     StringPhase(1) = TheStringIn
  246.     For n = 2 To UBound(StringPhase) ' Phase analysis.
  247.         StringPhase(n) = Right$(StringPhase(n - 1), Len(StringPhase(n - 1)) - 1) + Left$(StringPhase(n - 1), 1)
  248.     Next
  249.  
  250.     If (pswitch = 1) Then
  251.         Print
  252.         For n = 1 To _Width
  253.             Print "-";
  254.         Next
  255.         Print
  256.     End If
  257.  
  258.     If (arrweight(1) <> 0) Then Call CreateHisto(StringPhase(), 1, Alphabet1())
  259.     If (arrweight(2) <> 0) Then Call CreateHisto(StringPhase(), 2, Alphabet2())
  260.     If (arrweight(3) <> 0) Then Call CreateHisto(StringPhase(), 3, Alphabet3())
  261.     If (arrweight(4) <> 0) Then Call CreateHisto(StringPhase(), 4, Alphabet4())
  262.     If (arrweight(5) <> 0) Then Call CreateHisto(StringPhase(), 5, Alphabet5())
  263.     If (arrweight(6) <> 0) Then Call CreateHisto(StringPhase(), 6, Alphabet6())
  264.     If (arrweight(7) <> 0) Then Call CreateHisto(StringPhase(), 7, Alphabet7())
  265.     If (arrweight(8) <> 0) Then Call CreateHisto(StringPhase(), 8, Alphabet8())
  266.     If (arrweight(9) <> 0) Then Call CreateHisto(StringPhase(), 9, Alphabet9())
  267.     If (arrweight(10) <> 0) Then Call CreateHisto(StringPhase(), 10, Alphabet10())
  268.     If (arrweight(11) <> 0) Then Call CreateHisto(StringPhase(), 11, Alphabet11())
  269.     If (arrweight(12) <> 0) Then Call CreateHisto(StringPhase(), 12, Alphabet12())
  270.     If (arrweight(13) <> 0) Then Call CreateHisto(StringPhase(), 13, Alphabet13())
  271.  
  272.     If (pswitch = 1) Then ' Set the last argument >=1 to print stats for that histogram.
  273.         If ((Len(TheStringIn) >= 1) And (arrweight(1) <> 0)) Then Call PrintHisto(Alphabet1(), 0)
  274.         If ((Len(TheStringIn) >= 2) And (arrweight(2) <> 0)) Then Call PrintHisto(Alphabet2(), 0)
  275.         If ((Len(TheStringIn) >= 3) And (arrweight(3) <> 0)) Then Call PrintHisto(Alphabet3(), 0)
  276.         If ((Len(TheStringIn) >= 4) And (arrweight(4) <> 0)) Then Call PrintHisto(Alphabet4(), 0)
  277.         If ((Len(TheStringIn) >= 5) And (arrweight(5) <> 0)) Then Call PrintHisto(Alphabet5(), 4)
  278.         If ((Len(TheStringIn) >= 6) And (arrweight(6) <> 0)) Then Call PrintHisto(Alphabet6(), 0)
  279.         If ((Len(TheStringIn) >= 7) And (arrweight(7) <> 0)) Then Call PrintHisto(Alphabet7(), 0)
  280.         If ((Len(TheStringIn) >= 8) And (arrweight(8) <> 0)) Then Call PrintHisto(Alphabet8(), 0)
  281.         If ((Len(TheStringIn) >= 9) And (arrweight(9) <> 0)) Then Call PrintHisto(Alphabet9(), 0)
  282.         If ((Len(TheStringIn) >= 10) And (arrweight(10) <> 0)) Then Call PrintHisto(Alphabet10(), 0)
  283.         If ((Len(TheStringIn) >= 11) And (arrweight(11) <> 0)) Then Call PrintHisto(Alphabet11(), 0)
  284.         If ((Len(TheStringIn) >= 12) And (arrweight(12) <> 0)) Then Call PrintHisto(Alphabet12(), 0)
  285.         If ((Len(TheStringIn) >= 13) And (arrweight(13) <> 0)) Then Call PrintHisto(Alphabet13(), 0)
  286.         Print
  287.     End If
  288.  
  289.     ' Set the last argument =1 to print guess for that histogram.
  290.     If ((Len(TheStringIn) >= 1) And (arrweight(1) <> 0)) Then Call MakeGuess(TheStringIn, 1, Alphabet1(), Partialguess(), 0)
  291.     If ((Len(TheStringIn) >= 2) And (arrweight(2) <> 0)) Then Call MakeGuess(TheStringIn, 2, Alphabet2(), Partialguess(), 0)
  292.     If ((Len(TheStringIn) >= 3) And (arrweight(3) <> 0)) Then Call MakeGuess(TheStringIn, 3, Alphabet3(), Partialguess(), 0)
  293.     If ((Len(TheStringIn) >= 4) And (arrweight(4) <> 0)) Then Call MakeGuess(TheStringIn, 4, Alphabet4(), Partialguess(), 0)
  294.     If ((Len(TheStringIn) >= 5) And (arrweight(5) <> 0)) Then Call MakeGuess(TheStringIn, 5, Alphabet5(), Partialguess(), pswitch)
  295.     If ((Len(TheStringIn) >= 6) And (arrweight(6) <> 0)) Then Call MakeGuess(TheStringIn, 6, Alphabet6(), Partialguess(), 0)
  296.     If ((Len(TheStringIn) >= 7) And (arrweight(7) <> 0)) Then Call MakeGuess(TheStringIn, 7, Alphabet7(), Partialguess(), 0)
  297.     If ((Len(TheStringIn) >= 8) And (arrweight(8) <> 0)) Then Call MakeGuess(TheStringIn, 8, Alphabet8(), Partialguess(), 0)
  298.     If ((Len(TheStringIn) >= 9) And (arrweight(9) <> 0)) Then Call MakeGuess(TheStringIn, 9, Alphabet9(), Partialguess(), 0)
  299.     If ((Len(TheStringIn) >= 10) And (arrweight(10) <> 0)) Then Call MakeGuess(TheStringIn, 10, Alphabet10(), Partialguess(), 0)
  300.     If ((Len(TheStringIn) >= 11) And (arrweight(11) <> 0)) Then Call MakeGuess(TheStringIn, 11, Alphabet11(), Partialguess(), 0)
  301.     If ((Len(TheStringIn) >= 12) And (arrweight(12) <> 0)) Then Call MakeGuess(TheStringIn, 12, Alphabet12(), Partialguess(), 0)
  302.     If ((Len(TheStringIn) >= 13) And (arrweight(13) <> 0)) Then Call MakeGuess(TheStringIn, 13, Alphabet13(), Partialguess(), 0)
  303.     If (pswitch = 1) Then Print
  304.  
  305.     If (pswitch = 1) Then
  306.         Print "Thinking:   ";
  307.         For k = LBound(Partialguess) To UBound(Partialguess)
  308.             If ((Len(TheStringIn) >= k) And (arrweight(k) <> 0)) Then
  309.                 Print Partialguess(k, 1);
  310.             Else
  311.                 Print "_ ";
  312.             End If
  313.         Next
  314.         Print
  315.     End If
  316.  
  317.     j = 0
  318.     r = 0
  319.  
  320.     ' Weighted average calculation
  321.     For k = LBound(Partialguess) To UBound(Partialguess)
  322.         If ((Len(TheStringIn) >= k) And (arrweight(k) <> 0)) Then
  323.             r = r + arrweight(k) * Partialguess(k, 1)
  324.             j = j + arrweight(k)
  325.         End If
  326.     Next
  327.     If (j <> 0) Then
  328.         r = r / j
  329.     End If
  330.  
  331.     If (pswitch = 1) Then Print "Predicting:  "; _Trim$(Str$(r))
  332.  
  333.     If (r > .5) Then
  334.         r = 1
  335.     Else
  336.         r = 0
  337.     End If
  338.  
  339.     If (pswitch = 1) Then
  340.         Print "Rounding to: "; _Trim$(Str$(r))
  341.     End If
  342.  
  343.     If (pswitch = 1) Then
  344.         For n = 1 To _Width
  345.             Print "-";
  346.         Next
  347.         Print
  348.     End If
  349.  
  350.     TheReturn = r
  351.     Analyze = TheReturn
  352.  
  353. Sub MakeGuess (TheStringIn As String, wid As Integer, arralpha() As LetterBin, arrguess() As Double, pswitch As Integer)
  354.     Dim TheReturn As Double
  355.     Dim As Integer j, k, n
  356.     TheReturn = 0
  357.     j = 1
  358.     k = 0
  359.     For n = 1 To UBound(arralpha)
  360.         If (Left$(arralpha(n).Signature, wid - 1) = Right$(TheStringIn, wid - 1)) Then
  361.             If (arralpha(n).Count >= j) Then
  362.                 If (pswitch = 1) Then Print "Order-"; Right$("0" + _Trim$(Str$(wid)), 2); " guess: "; arralpha(n).Signature; " . "; _Trim$(Str$(arralpha(n).Count))
  363.                 TheReturn = TheReturn + Val(Right$(arralpha(n).Signature, 1))
  364.                 k = k + 1
  365.                 j = arralpha(n).Count
  366.             End If
  367.         End If
  368.     Next
  369.     If (k <> 0) Then
  370.         TheReturn = TheReturn / k
  371.     Else
  372.         TheReturn = .5
  373.     End If
  374.     arrguess(wid, 1) = TheReturn
  375.     arrguess(wid, 2) = j
  376.  
  377. Sub InitializeModelIndexed (TheIndexIn As Integer)
  378.     '0 to 1023
  379.     Call InitializeModelLiteral(BIN$(TheIndexIn))
  380.  
  381. Sub InitializeModelLiteral (Weights As String)
  382.     Dim As Integer k
  383.     For k = 1 To 10
  384.         AlphaWeight(k) = Val(Mid$(Weights, k, 1))
  385.     Next
  386.     AlphaWeight(11) = 0
  387.     AlphaWeight(12) = 0
  388.     AlphaWeight(13) = 0
  389.  
  390. Sub InitializeModelCustom (Weights As String)
  391.     Dim As Integer k
  392.     If (Weights = "-1") Then
  393.         For k = LBound(AlphaWeight) To UBound(AlphaWeight)
  394.             AlphaWeight(k) = k ^ 2
  395.         Next
  396.     End If
  397.     AlphaWeight(11) = 0
  398.     AlphaWeight(12) = 0
  399.     AlphaWeight(13) = 0
  400.  
  401.     ' Butchered from the Wiki. Ugliest function ever.
  402.     Dim As Integer max, i, msb
  403.     Dim As String b
  404.     max% = 8 * Len(n%)
  405.     For i = max% - 1 To 0 Step -1
  406.         If (n% And 2 ^ i) Then msb% = 1: b$ = "1" + b$ Else If msb% Then b$ = "0" + b$
  407.     Next
  408.     b$ = b$ + "0000000000"
  409.     b$ = Left$(b$, 10)
  410.     BIN$ = b$
  411.  
  412. Sub CreateHisto (arrseqphase() As String, wid As Integer, arralpha() As LetterBin)
  413.     Dim As Integer j, k, n
  414.     For n = 1 To UBound(arralpha)
  415.         arralpha(n).Count = 0
  416.     Next
  417.     ' Uncomment this loop to enable phase analysis.
  418.     ' Hack j=1 to use base string only.
  419.     For j = 1 To 1 'wid
  420.         For k = 1 To Len(arrseqphase(j)) - (Len(arrseqphase(j)) Mod wid) Step wid
  421.             For n = 1 To UBound(arralpha)
  422.                 If (Mid$(arrseqphase(j), k, wid) = arralpha(n).Signature) Then
  423.                     arralpha(n).Count = arralpha(n).Count + 1
  424.                 End If
  425.             Next
  426.         Next
  427.     Next
  428.     Call QuickSort(arralpha(), 1, UBound(arralpha))
  429.  
  430. Sub PrintHisto (arr() As LetterBin, wid As Integer)
  431.     Dim As Integer j, n
  432.     If (wid > 0) Then
  433.         If (wid > UBound(arr)) Then
  434.             j = UBound(arr)
  435.         Else
  436.             j = wid
  437.         End If
  438.         Print "Histogram: "; _Trim$(Str$(UBound(arr))); "-letter regroup, showing top "; _Trim$(Str$(wid))
  439.         For n = 1 To j
  440.             Print arr(n).Signature; arr(n).Count
  441.         Next
  442.     End If
  443.  
  444. Sub PrintGraph (TheString As String, arrgrade() As Double)
  445.     Dim As Integer j, k
  446.     Dim As Double f, g
  447.     For k = 1 To _Width
  448.         Locate _Height - 5, k: Print "_"
  449.         Locate _Height - 5 - 10, k: Print "_"
  450.     Next
  451.     Locate _Height - 5 + 1, 1: Print "0%"
  452.     Locate _Height - 5 - 10 - 1, 1: Print "100%"
  453.     f = (_Width) / Len(TheString)
  454.     If (f > 1) Then f = 1
  455.     For j = 2 To Len(TheString)
  456.         g = Int(j * f)
  457.         If (g = 0) Then g = 1
  458.         Locate _Height - 5 - Int(10 * arrgrade(j, 1)), g
  459.         If (arrgrade(j, 2) = 1) Then
  460.             Print Chr$(251)
  461.         Else
  462.             Print "x"
  463.         End If
  464.     Next
  465.  
  466. Sub NewAlphabet (arrold() As LetterBin, arrnew() As LetterBin)
  467.     Dim As Integer j, k, n
  468.     n = 0
  469.     For k = 1 To 2
  470.         For j = 1 To UBound(arrold)
  471.             n = n + 1
  472.             arrnew(n).Signature = arrold(j).Signature
  473.         Next
  474.     Next
  475.     For j = 1 To UBound(arrnew)
  476.         If (j <= UBound(arrnew) / 2) Then
  477.             arrnew(j).Signature = "0" + arrnew(j).Signature
  478.         Else
  479.             arrnew(j).Signature = "1" + arrnew(j).Signature
  480.         End If
  481.     Next
  482.  
  483. Sub QuickSort (arr() As LetterBin, LowLimit As Long, HighLimit As Long)
  484.     Dim As Long piv
  485.     If (LowLimit < HighLimit) Then
  486.         piv = Partition(arr(), LowLimit, HighLimit)
  487.         Call QuickSort(arr(), LowLimit, piv - 1)
  488.         Call QuickSort(arr(), piv + 1, HighLimit)
  489.     End If
  490.  
  491. Function Partition (arr() As LetterBin, LowLimit As Long, HighLimit As Long)
  492.     Dim As Long i, j
  493.     Dim As Double pivot, tmp
  494.     pivot = arr(HighLimit).Count
  495.     i = LowLimit - 1
  496.     For j = LowLimit To HighLimit - 1
  497.         tmp = arr(j).Count - pivot
  498.         If (tmp >= 0) Then
  499.             i = i + 1
  500.             Swap arr(i), arr(j)
  501.         End If
  502.     Next
  503.     Swap arr(i + 1), arr(HighLimit)
  504.     Partition = i + 1
  505.  
  506. Function Pathological$ (TheSeed As String, TheLength As Integer)
  507.     Dim TheReturn As String
  508.     TheReturn = TheSeed
  509.     Dim p
  510.     Do
  511.         p = Analyze(TheReturn, AlphaWeight(), 0)
  512.         If (p = 1) Then
  513.             TheReturn = TheReturn + "0"
  514.         Else
  515.             TheReturn = TheReturn + "1"
  516.         End If
  517.     Loop Until Len(TheReturn) = TheLength
  518.     Pathological$ = TheReturn
  519.  
  520. Function QBPRNG$ (TheSeed As Double, TheLength As Integer)
  521.     Dim TheReturn As String
  522.     Dim k As Integer
  523.     Randomize TheSeed
  524.     For k = 1 To TheLength
  525.         If (Rnd > .5) Then
  526.             TheReturn = TheReturn + "1"
  527.         Else
  528.             TheReturn = TheReturn + "0"
  529.         End If
  530.     Next
  531.     QBPRNG$ = TheReturn
  532.  
  533. Function LoadTestFile (alwayszero As Integer, TheFile As String, ReversalToggle As Integer)
  534.     Dim As Integer j, k
  535.     Dim n As Integer
  536.     Dim a As String
  537.     n = alwayszero
  538.     Open TheFile For Input As #1
  539.     Do While Not EOF(1)
  540.         n = n + 1
  541.         Line Input #1, a
  542.         TestData(n) = a
  543.     Loop
  544.     Close #1
  545.     If (ReversalToggle = -1) Then
  546.         For k = 1 To n
  547.             a = TestData(k)
  548.             TestData(k) = ""
  549.             For j = Len(a) To 1 Step -1
  550.                 TestData(k) = TestData(k) + Mid$(a, j, 1)
  551.             Next
  552.         Next
  553.     End If
  554.     LoadTestFile = n
  555.  
  556. Function LoadTestData (alwayszero As Integer)
  557.     Dim n As Integer
  558.     n = alwayszero
  559.  
  560.     '''
  561.     ' Percussive cases:
  562.     '''
  563.     'n = n + 1: TestData(n) = "1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111"
  564.     'n = n + 1: TestData(n) = "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
  565.     'n = n + 1: TestData(n) = "0101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101"
  566.     'n = n + 1: TestData(n) = "1010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010"
  567.     'n = n + 1: TestData(n) = "0001110011000111001100011100110001110011000111001100011100110001110011000111001100011100110001110011000111001100011100110001110011000111001100011100110001110011"
  568.     'n = n + 1: TestData(n) = "0100010111010001011101000101110100010111010001011101000101110100010111010001011101000101110100010111010001011101000101110100010111010001011101000101110100010111"
  569.  
  570.     '''
  571.     ' Human samples:
  572.     '''
  573.     ' (from Keybone)
  574.     n = n + 1: TestData(n) = "101010101010101010101001010101010101001010111001010101010101010101010100010101010101010100101001010101001100101010001010100101010100101010100101010101010101010011011110010101010100100101010110010011001010011001010100010100101010010101010101010010101010101010010101001010101010100110010101010100101010101010011001001010100101010010101010100101010010101001010100101001010010101010111010100110011001010101010100110101001010101010100101001010111010101010101010100101001010101010010101010101001010101001010101001010100101010100101010010101010101001010101001010101010101001010101001010100101010101010010101010010010101010101010101010010100101010101001010100101001010101001111101010101010100101010110011001010101010101010110101010101101010101010100101010010101010010101010101101110010101001010101010110010100101010101001011010101010100110101010100101010010101010100101010101001010101010101001010101010011010101010101110110100101010111010101011011001011001010101001010101010101010101010011001010101010100101010101010101010010100101"
  575.     ' (from Keybone)
  576.     n = n + 1: TestData(n) = "0101110101100011010100101011001110001011001010001110101111010100111011100100101001010011110101101000101010001010101111001010111010101010100001010101000101101100101111101010010101110110111001000101000011010101010001001001001111101011101010100010110101110101100000101010101110111010100100100001110111100101011110101010001010001110010110111110110010101001001011101000101001011100011101000010101010101101010010110100101101000101111010101110111001010011101111010101000010101111100010101011110101011011110100001010110"
  577.     ' (from Loudar)
  578.     n = n + 1: TestData(n) = "1011001010010100100100110010101010101001010101010101011010010101001010101001010010100110101011010101010101011010101101010101010101010010110101010101100101010101010110101101011010010101010010100110101101001010110101011010010101101010110100101111010101010011011011010010110101010010110100101101010100101011010010101001010101010001011101011010010101011100111010010001101011110010011010001011100110101010010011010101001001010010000101010110001"
  579.     ' (from Luke)
  580.     n = n + 1: TestData(n) = "01100101001010001100001101101111011010010101010110110101001000001111001111110101000101111011010101111101010101101010101001010101011000010101010101001011010100110100110100110011010101010101110101010111111101011010100000001101111000010111000110111001000010100001101010110100000111101011111100001011001010110010110"
  581.     ' (from Sarafromct)
  582.     n = n + 1: TestData(n) = "10101010101011101000011101010111010101010101100111001010100111100001011011110101000001111010101101010000001111110011111110111101110111001110110010000100010101010101010100101011010110101010101010101001000000001111110000011110101010101010100010101110101010101101111111111111111111101010101010101000000"
  583.     ' (from Spriggs)
  584.     n = n + 1: TestData(n) = "10111010101010101010101001010101010101001010101001010101010101010101010101010101010101010101010101010101001010100100100101010101010101001010100101010101010100101010100101010101010101010101001010010110010101010010101010101010101010101010100101001001001010101010101010101010101001010101001001101010010"
  585.     ' (from Spriggs)
  586.     n = n + 1: TestData(n) = "11111011110100101011111111110100000011011110101100111100111111110111101110100111100110011111110101111111010111101111100111110111111111111011100111110111111110010000101011111001110101101010110111110"
  587.     ' (from Hotpants)
  588.     n = n + 1: TestData(n) = "01010100011001010010101010101010101000110101010111101010100100011010101010100100101110010010010100001010101001010101010110010001001011000100100110101001001001010000000001010101101111101001010100010101001001010101000100101001100100010011010101010101010111010010101011101011011010110100100010010100100100010010001001"
  589.  
  590.     '''
  591.     ' Noted sequences:
  592.     '''
  593.     ' (Wolfram rule 30)
  594.     n = n + 1: TestData(n) = "110111001100010110010011101011100111010101100001100101011010101111110000111100010101110000010010110001110001101101101000000010001111101110100111000111010111000001100100011001111001111110000001111111011001011011100000101100011011000110001110110110010101111111011010110110111101110010111011000100000000001101110010110010111100100110000111110000001011011001111001000010011111000001101001011001001011101011000001101001000101001011101011111011000100000011110101000111101001011010001101000111100001000011110001111010"
  595.  
  596.     LoadTestData = n
  597.  
  598. ''' Museum:
  599. 'Call InitializeModelIndexed(BinaryModelIndex) ' Goes with counter
  600. 'Call InitializeModelIndexed(0)                ' Always zero
  601. 'Call InitializeModelIndexed(1023)             ' Homogeneous
  602. 'Call InitializeModelIndexed(16)               ' This 5-gram case (16) works best for Gaming mode.
  603. 'Call InitializeModelIndexed(82)               ' Learning algo discoverd this is a good one against humans.
  604. 'Call InitializeModelIndexed(18)               ' Learning algo discoverd this is a good one against humans.
  605. 'Call InitializeModelCustom(-1)                ' Enables custom model(s).
  606. '''
  607.  
  608. '''
  609. ' Studies in pathology:
  610. 'BinaryModelIndex = 2   ' cracked by 124
  611. 'BinaryModelIndex = 3   ' cracked by 16
  612. 'BinaryModelIndex = 4   ' cracked by 265
  613. 'BinaryModelIndex = 5   ' cracked by 736
  614. 'BinaryModelIndex = 6   ' cracked by 49
  615. 'BinaryModelIndex = 7   ' cracked by 88
  616. 'BinaryModelIndex = 8   ' cracked by xxx
  617. 'BinaryModelIndex = 9   ' cracked by xxx
  618. 'BinaryModelIndex = 10  ' cracked by 644
  619. 'BinaryModelIndex = 11  ' cracked by 261
  620. '''
  621.  
« Last Edit: December 28, 2021, 12:25:43 pm by STxAxTIC »
You're not done when it works, you're done when it's right.

Offline random1

  • Newbie
  • Posts: 86
Re: Looking for old program or help recreating it
« Reply #89 on: December 28, 2021, 04:24:55 pm »
STxAxTIC

What if we change the output so that (0)=miss and (1)=hit and then run that string back through
the predictor to see what happens.  Repeat this process as many times as needed to produce the
highest level of accuracy that can be obtained.  Kind of a noise cancellation feedback loop. 

I think the output string shows structure with a little noise thrown in here and there, if we can remove
the noise then then who knows what the results will show.  I have been working on a couple simple
tools but have not figured out how to combine the outputs so that the accuracy improves, so far my
attempts show a negative effect.

Anyway, you seem to have a lot cooking on the back burner so maybe when time permits you can
check it out.

I will bookmark the new link so I can stay abreast of any updates.

R1