Author Topic: Binary Sequence Predictor "game"?  (Read 3657 times)

0 Members and 1 Guest are viewing this topic.

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
Re: Binary Sequence Predictor "game"?
« Reply #15 on: December 14, 2021, 01:34:14 pm »
I would consider that pretty baseline too. Test it out on all those strings at the bottom of my code (smartass).
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: Binary Sequence Predictor "game"?
« Reply #16 on: December 14, 2021, 01:40:05 pm »
By "long-term" I mean what's going on in the screenshot. Your answer helplessly pulls toward 50% no matter what really happens when you aren't busy knocking over straw men. Follow that link to the external site above, you may learn something (not from me, I know).

 
sssss.png
You're not done when it works, you're done when it's right.

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • Steve’s QB64 Archive Forum
Re: Binary Sequence Predictor "game"?
« Reply #17 on: December 14, 2021, 01:43:21 pm »
I would consider that pretty baseline too. Test it out on all those strings at the bottom of my code (smartass).

But all those strings are pattern based and not really based on someone trying to be random, aren't they? 

As far as I can tell, just a random guesser that does an even/odd guess is pretty good at guessing what I'm going to click!

 
SS2.png


Almost a 60% accuracy, I was clicking left and right as randomly as I possibly could!  Apparently, me and my PC are in sync and it can read my mind!  I just don't know if that makes me MORE random than the average bear, or LESS...  Whichever it is, QB64 is pretty dang good at figuring out my next move!
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
Re: Binary Sequence Predictor "game"?
« Reply #18 on: December 14, 2021, 01:49:29 pm »
Quote
But all those strings are pattern based and not really based on someone trying to be random, aren't they?

So what? If your code predicted anything, it would get those answers right.

Quote
As far as I can tell, just a random guesser that does an even/odd guess is pretty good at guessing what I'm going to click!

I know man, it's as far as you can tell. It's because you won't try the tests, won't really read anything, and you don't want to learn a thing from me, I know.

Show me your straw-man 60% accuracy case when you've fed it 300 input characters, or 3000.

Anyway, your public misunderstanding of this, as per usual directive, is on high display. Did you have a real question, or is this troll session over?
You're not done when it works, you're done when it's right.

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • Steve’s QB64 Archive Forum
Re: Binary Sequence Predictor "game"?
« Reply #19 on: December 14, 2021, 02:01:32 pm »
Anyway, your public misunderstanding of this, as per usual directive, is on high display. Did you have a real question, or is this troll session over?

And ^this is why I insist you're the complete center of an asshole.

You post a screenshot showing 58% on 46 guesses.  You then tell us:

Quote
Qualitatively, this thing tends toward the high 50's, low 60's when I'm "trying" to be random. Since I've been staring at binary for some weeks now in various projects, I've become pretty good at beating the machine... for a while. The best I can do is keep it in the high 40's for 150 or so characters, then it catches on and it's right back to high-50s prediction rates. It continues to astound.

So your ASTOUNDING predictor gives you numbers between 40 and 60%, with a high of "high 40's"....

COLOR ME IMPRESSED!!

Also color me through with this topic, and YOU in general.  Asking "How is your shit better than a complete random predictor, based off your own results," isn't trolling.  I *was* wondering what I was missing out on that was so ASTOUNDish, but now I don't give a damn.

As one third of Odin, feel free to remove all my posts in this topic.  I'm finished with it and your grand ass delusions of astounding genius.  FU!!
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
Re: Binary Sequence Predictor "game"?
« Reply #20 on: December 14, 2021, 02:04:27 pm »
Don't you have a coloring book to be working on?
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: Binary Sequence Predictor "game"?
« Reply #21 on: December 14, 2021, 10:13:05 pm »
Alright, made this thing quite a bit better, freakishly better. I deleted my main loop and re-coded the interface a few times, and ultimately decided on ultimate simplicity. There isn't even an INPUT statement anymore, you input the string into the code.

I also had this eureka moment - instead of testing a whole string and getting ONE prediction, why not make the program guess every single next character that's coming? Way better test, right? So it does that now. To be clear, here's what I mean: Suppose you feed the program 10010100010001. The first thing it does is sets the whole string aside, and then *pretends* that you trickle-fed the thing one character at a time. So on the first iteration it convinces itself you typed a 1, and then 10, and then 100, and then 1001, and then 10010, and so on. With each iteration, the program tries to guess the next number and reports on itself.

The results are crazy. Here's an example or two:

Consider the string:


Code: QB64: [Select]
  1. TheString = "00101010001100101010010101010100101010010100101010010101010100100000101011110101001010010101010010000011101010100101010101001010010101010101010110101001010100101010101001010100101010100101010100101010101001010010101010010101010101010100101010101010101010101001010101010100101010101001010101001101010" ' 78
  2.  
[/s]

Looks random enough, right? Welp, when I feed that through the program, the program can always guess the next letter 78% of the time. The string length is 299 for no good reason.

How about this one next?


Code: QB64: [Select]
  1. TheString = "10101011100101100101010101010101010101010101010101010101010010011010100000000011111111111001011001101010101010110010101010101010101010101010100101100101010101010110011101011110101010101010101101101010101111010101100101001011010010101010101011010101001110101010111101110011010011001101001101011000101" ' 68
  2.  
[/s]

For that string, the program sees what's coming 68% of the time. If you think this is somehow biased or buggy, you can always test with a "random" string not made by a human, but by a program. Alas, feeding this string into it:

Code: QB64: [Select]
  1. TheString = "11100101110011011010110100110011111011010110100100000110000100101001001010011100111101101110000001000000011011100101110000000111100100011101000000101000110100001000000001111010101011000010001110111110001001110101011000010101001111010100100000011100110110110000111010001010000011010000101111101011000" ' using RND function
  2.  
[/s]

... the program doesn't stray too far from 50/50. It's 'cause I cooked this data with QB64's RND function. Basically you get the same standard deviation you'd see in a random walk, as you should. Any truly random data I feed it hovers around 50%. Good... so it works! So back to the hand-pounded data: I cannot believe what kind of results I'm getting. I'm 70% predictable?!

Try your own string. Hammer out a few hundred 0's and 1's and save that string in the program. It runs nice and fast, to the point where I had to slow it down by adding a delay. (Evidently it had some accuracy to spare, too. It doesn't seem to mind the cruder calclation.) Consider this the latest and greatest so far:


Code: QB64: [Select]
  1.  
  2. Screen _NewImage(100, 30)
  3.  
  4. ' Version: 10
  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. Dim TheString As String
  42. Dim predictedGuess As Integer
  43. Dim correctGuesses As Double
  44. Dim totalGuesses As Double
  45. Dim progressReport(1 To _Width) As Double
  46.  
  47. TheString = "101010101010101010101010101010101010101010101010101010101010101010101010"
  48. 'TheString = "10101010101011101000011101010111010101010101100111001010100111100001011011110101000001111010101101010000001111110011111110111101110111001110110010000100010101010101010100101011010110101010101010101001000000001111110000011110101010101010100010101110101010101101111111111111111111101010101010101000000" ' 63
  49. 'TheString = "11100101110011011010110100110011111011010110100100000110000100101001001010011100111101101110000001000000011011100101110000000111100100011101000000101000110100001000000001111010101011000010001110111110001001110101011000010101001111010100100000011100110110110000111010001010000011010000101111101011000" ' using RND function
  50. 'TheString = "00101010001100101010010101010100101010010100101010010101010100100000101011110101001010010101010010000011101010100101010101001010010101010101010110101001010100101010101001010100101010100101010100101010101001010010101010010101010101010100101010101010101010101001010101010100101010101001010101001101010" ' 78
  51. 'TheString = "11100101010011001001001010101001010000101001000010100010110111010101010011010100100100110101010010010110100101001001010010101010010010100101001010010100100101001001010010010110010010101010101001010101001010101010010101001001010101001010101010101010101010101010101010010101001010010100101001010101001" ' 68
  52. 'TheString = "10101011100101100101010101010101010101010101010101010101010010011010100000000011111111111001011001101010101010110010101010101010101010101010100101100101010101010110011101011110101010101010101101101010101111010101100101001011010010101010101011010101001110101010111101110011010011001101001101011000101" ' 68
  53. 'TheString = "10101101000110101000101010101010101010100101010101010100101110010101001001010100101010101001001010101001010000010010001010010010101010100110010101010101010101010110010101010010100101010010101010101001010101010101010010101010101010101010010101010101010101010101010010101001001010010100101010101010101" ' 76
  54.  
  55. Dim f
  56.  
  57. For j = 1 To Len(TheString)
  58.     Cls
  59.     Locate 1, 1
  60.     Print "Analyzing:"
  61.     Print
  62.     Print Left$(TheString, j) + "["; Right$(TheString, Len(TheString) - j); "]"
  63.     Print
  64.     predictedGuess = Analyze(Left$(TheString, j), Mid$(TheString, j + 1, 1), 0)
  65.     Print "Prediction: "; _Trim$(Str$(predictedGuess))
  66.     Print "Actual:     "; _Trim$(Mid$(TheString, j + 1, 1))
  67.     If (predictedGuess = Val(Mid$(TheString, j + 1, 1))) Then
  68.         correctGuesses = correctGuesses + 1
  69.     End If
  70.     totalGuesses = totalGuesses + 1
  71.     Print "I have been correct for "; _Trim$(Str$(Int(100 * correctGuesses / totalGuesses))); "% of "; _Trim$(Str$(totalGuesses)); " guesses."
  72.     Print "Standard deviation: "; _Trim$(Str$(Sqr(j)));
  73.  
  74.     f = (_Width - 1) / Int(Len(TheString))
  75.     If (f > 1) Then f = 1 / f
  76.     progressReport(1 + Int(j * f)) = correctGuesses / totalGuesses
  77.  
  78.     For k = 1 To 1 + Int(j * (_Width - 1) / Int(Len(TheString)))
  79.         Locate 20 - Int(10 * progressReport(1 + Int(k * f))), k: Print "*"
  80.     Next
  81.  
  82.     _Delay .05
  83.     _Display
  84.  
  85.  
  86. Function Analyze (TheStringIn As String, ActualIn As String, pswitch As Integer)
  87.     Dim TheReturn As Integer
  88.     Dim As Integer n
  89.     Dim As Double r, j, k, h
  90.     Dim Fingerprint(16) As String
  91.     Dim p(2 To 10, 2) As Double ' Change the upper bound to a higer number for more accuracy.
  92.  
  93.     ' Create shifted versions of string, i.e. ABCD -> BCDA, CDAB, DABC, ABCD, BCDA, etc.
  94.     Fingerprint(1) = TheStringIn
  95.     For n = 2 To UBound(Fingerprint)
  96.         Fingerprint(n) = Right$(Fingerprint(n - 1), Len(Fingerprint(n - 1)) - 1) + Left$(Fingerprint(n - 1), 1)
  97.     Next
  98.  
  99.     ' Initialize partial results.
  100.     For n = LBound(p) To UBound(p)
  101.         p(n, 1) = -999
  102.     Next
  103.  
  104.     Call CreateHisto(Fingerprint(), Alphabet2(), 2)
  105.     Call CreateHisto(Fingerprint(), Alphabet3(), 3)
  106.     Call CreateHisto(Fingerprint(), Alphabet4(), 4)
  107.     Call CreateHisto(Fingerprint(), Alphabet5(), 5)
  108.     Call CreateHisto(Fingerprint(), Alphabet6(), 6)
  109.     Call CreateHisto(Fingerprint(), Alphabet7(), 7)
  110.     Call CreateHisto(Fingerprint(), Alphabet8(), 8)
  111.     Call CreateHisto(Fingerprint(), Alphabet9(), 9)
  112.     Call CreateHisto(Fingerprint(), Alphabet10(), 10)
  113.     'Call CreateHisto(Fingerprint(), Alphabet11(), 11)
  114.     'Call CreateHisto(Fingerprint(), Alphabet12(), 12)
  115.     'Call CreateHisto(Fingerprint(), Alphabet13(), 13)
  116.  
  117.     If (pswitch = 1) Then
  118.         For n = 1 To _Width
  119.             Print "-";
  120.         Next
  121.         Print
  122.     End If
  123.  
  124.     If (pswitch = 1) Then
  125.         If (Len(TheStringIn) >= 2) Then Call PrintHisto(Alphabet2(), 3) ' Set the last number >=1 to print stats for that histogram.
  126.         If (Len(TheStringIn) >= 3) Then Call PrintHisto(Alphabet3(), 3)
  127.         If (Len(TheStringIn) >= 4) Then Call PrintHisto(Alphabet4(), 0)
  128.         If (Len(TheStringIn) >= 5) Then Call PrintHisto(Alphabet5(), 0)
  129.         If (Len(TheStringIn) >= 6) Then Call PrintHisto(Alphabet6(), 0)
  130.         If (Len(TheStringIn) >= 7) Then Call PrintHisto(Alphabet7(), 0)
  131.         If (Len(TheStringIn) >= 8) Then Call PrintHisto(Alphabet8(), 0)
  132.         If (Len(TheStringIn) >= 9) Then Call PrintHisto(Alphabet9(), 0)
  133.         If (Len(TheStringIn) >= 10) Then Call PrintHisto(Alphabet10(), 0)
  134.         'If (Len(TheStringIn) >= 11) Then Call PrintHisto(Alphabet11(), 0)
  135.         'If (Len(TheStringIn) >= 12) Then Call PrintHisto(Alphabet12(), 0)
  136.         'If (Len(TheStringIn) >= 13) Then Call PrintHisto(Alphabet13(), 0)
  137.         Print
  138.     End If
  139.  
  140.     If (Len(TheStringIn) >= 2) Then Call MakeGuess(TheStringIn, Alphabet2(), 2, p(), pswitch) ' Set the last number =1 to print guess for that histogram.
  141.     If (Len(TheStringIn) >= 3) Then Call MakeGuess(TheStringIn, Alphabet3(), 3, p(), pswitch)
  142.     If (Len(TheStringIn) >= 4) Then Call MakeGuess(TheStringIn, Alphabet4(), 4, p(), 0)
  143.     If (Len(TheStringIn) >= 5) Then Call MakeGuess(TheStringIn, Alphabet5(), 5, p(), 0)
  144.     If (Len(TheStringIn) >= 6) Then Call MakeGuess(TheStringIn, Alphabet6(), 6, p(), 0)
  145.     If (Len(TheStringIn) >= 7) Then Call MakeGuess(TheStringIn, Alphabet7(), 7, p(), 0)
  146.     If (Len(TheStringIn) >= 8) Then Call MakeGuess(TheStringIn, Alphabet8(), 8, p(), 0)
  147.     If (Len(TheStringIn) >= 9) Then Call MakeGuess(TheStringIn, Alphabet9(), 9, p(), 0)
  148.     If (Len(TheStringIn) >= 10) Then Call MakeGuess(TheStringIn, Alphabet10(), 10, p(), 0)
  149.     'If (Len(TheStringIn) >= 11) Then Call MakeGuess(TheStringIn, Alphabet11(), 11, p(), 0)
  150.     'If (Len(TheStringIn) >= 12) Then Call MakeGuess(TheStringIn, Alphabet12(), 12, p(), 0)
  151.     'If (Len(TheStringIn) >= 13) Then Call MakeGuess(TheStringIn, Alphabet13(), 13, p(), 0)
  152.     If (pswitch = 1) Then Print
  153.  
  154.     If (pswitch = 1) Then
  155.         Print "Analyzing:"
  156.         Print TheStringIn
  157.  
  158.         Print
  159.         Print "Thinking:";
  160.         For k = LBound(p) To UBound(p)
  161.             If (p(k, 1) <> -999) Then
  162.                 Print p(k, 1);
  163.             Else
  164.                 Print "_ ";
  165.             End If
  166.         Next
  167.         Print
  168.     End If
  169.  
  170.     j = 0
  171.     r = 0
  172.  
  173.     For k = UBound(p) To LBound(p) Step -1
  174.         If (p(k, 1) <> -999) Then
  175.  
  176.             ' This is the made-up part of the model:
  177.             ' The variable r contributes to weighted average.
  178.             ' The variable j is used for normalization.
  179.             ' Scaling factor h influences weighted average calculaton.
  180.             ' The factors multiplying h are totally arbitrary. Notes:
  181.             '   setting o(h^2) means the later alphabets count for more.
  182.             '   p(k, 1) euqals the calculated guess at frequency k.
  183.             '   p(k, 2) euqals the peak count of the unscaled histogram.
  184.             '   ...while p(k, 2) is here, it does not seem to help calculations.
  185.  
  186.             h = 1 + k - LBound(p)
  187.  
  188.             h = h ^ 2
  189.  
  190.             ' Standard weighted average:
  191.             r = r + h * p(k, 1)
  192.             j = j + h
  193.  
  194.         End If
  195.     Next
  196.     If (j <> 0) Then
  197.         r = r / j
  198.     End If
  199.  
  200.     If (pswitch = 1) Then Print "Predicting:  "; _Trim$(Str$(r))
  201.  
  202.     If (r > .5) Then
  203.         r = 1
  204.     Else
  205.         r = 0
  206.     End If
  207.  
  208.     If (pswitch = 1) Then
  209.         Print "Rounding to: "; _Trim$(Str$(r))
  210.  
  211.         ' Just for show, do the most naive thing possible by counting 1's.
  212.         n = Len(TheStringIn)
  213.         h = 0
  214.         For k = 1 To n
  215.             If Val(Mid$(TheStringIn, k, 1)) = 1 Then h = h + 1
  216.         Next
  217.         h = h / n
  218.         Print
  219.         Print "Naive (dec): "; _Trim$(Str$(h))
  220.         If (h > .5) Then
  221.             h = 1
  222.         Else
  223.             h = 0
  224.         End If
  225.         Print "Naive (int): "; _Trim$(Str$(h))
  226.  
  227.         ' Compare result to actual/known data if it was specified.
  228.         If (ActualIn <> "?") Then
  229.             Print
  230.             Print "Actual:      "; ActualIn
  231.             If (_Trim$(Str$(r)) <> ActualIn) Then
  232.                 Beep
  233.                 Print
  234.                 Print "*** MISMATCH ***"
  235.             End If
  236.         End If
  237.     End If
  238.  
  239.     TheReturn = r
  240.     Analyze = TheReturn
  241.  
  242. Sub MakeGuess (OrigString As String, arralpha() As LetterBin, wid As Integer, arrbeta() As Double, pswitch As Integer)
  243.     Dim TheReturn As Double
  244.     Dim As Integer j, k, n
  245.     TheReturn = 0
  246.     j = 1 '0
  247.     k = 0
  248.     For n = 1 To UBound(arralpha)
  249.         If (Left$(arralpha(n).Signature, wid - 1) = Right$(OrigString, wid - 1)) Then
  250.             If (arralpha(n).Count >= j) Then
  251.                 If (pswitch = 1) Then Print "Order-"; Right$("0" + _Trim$(Str$(wid)), 2); " guess: "; arralpha(n).Signature; " . "; _Trim$(Str$(arralpha(n).Count))
  252.                 TheReturn = TheReturn + Val(Right$(arralpha(n).Signature, 1))
  253.                 k = k + 1
  254.                 j = arralpha(n).Count
  255.             End If
  256.         End If
  257.     Next
  258.     If (k <> 0) Then
  259.         TheReturn = TheReturn / k
  260.         arrbeta(wid, 1) = TheReturn
  261.         arrbeta(wid, 2) = j
  262.     Else
  263.         TheReturn = .5
  264.         arrbeta(wid, 1) = TheReturn
  265.         arrbeta(wid, 2) = j
  266.     End If
  267.  
  268. Sub CreateHisto (arrfinger() As String, arralpha() As LetterBin, w As Integer)
  269.     Dim As Integer j, k, n
  270.     For n = 1 To UBound(arralpha)
  271.         arralpha(n).Count = 0
  272.     Next
  273.     For j = 1 To w
  274.         For k = 1 To Len(arrfinger(j)) - (Len(arrfinger(j)) Mod w) Step w '- 0 Step 1 'w 'make the 0 a -w? might not matter at all
  275.             For n = 1 To UBound(arralpha)
  276.                 If (Mid$(arrfinger(j), k, w) = arralpha(n).Signature) Then
  277.                     arralpha(n).Count = arralpha(n).Count + 1
  278.                 End If
  279.             Next
  280.         Next
  281.     Next
  282.     Call QuickSort(arralpha(), 1, UBound(arralpha))
  283.  
  284. Sub PrintHisto (arr() As LetterBin, w As Integer)
  285.     Dim As Integer j, n
  286.     If (w > 0) Then
  287.         If (w > UBound(arr)) Then
  288.             j = UBound(arr)
  289.         Else
  290.             j = w
  291.         End If
  292.         Print "Histogram: "; _Trim$(Str$(UBound(arr))); "-letter regroup, showing top "; _Trim$(Str$(w))
  293.         For n = 1 To j
  294.             Print arr(n).Signature; arr(n).Count
  295.         Next
  296.     End If
  297.  
  298. Sub NewAlphabet (arrold() As LetterBin, arrnew() As LetterBin)
  299.     Dim As Integer j, k, n
  300.     n = 0
  301.     For k = 1 To 2
  302.         For j = 1 To UBound(arrold)
  303.             n = n + 1
  304.             arrnew(n).Signature = arrold(j).Signature
  305.         Next
  306.     Next
  307.     For j = 1 To UBound(arrnew)
  308.         If (j <= UBound(arrnew) / 2) Then
  309.             arrnew(j).Signature = "0" + arrnew(j).Signature
  310.         Else
  311.             arrnew(j).Signature = "1" + arrnew(j).Signature
  312.         End If
  313.     Next
  314.  
  315. Sub QuickSort (arr() As LetterBin, LowLimit As Long, HighLimit As Long)
  316.     Dim As Long piv
  317.     If (LowLimit < HighLimit) Then
  318.         piv = Partition(arr(), LowLimit, HighLimit)
  319.         Call QuickSort(arr(), LowLimit, piv - 1)
  320.         Call QuickSort(arr(), piv + 1, HighLimit)
  321.     End If
  322.  
  323. Function Partition (arr() As LetterBin, LowLimit As Long, HighLimit As Long)
  324.     Dim As Long i, j
  325.     Dim As Double pivot, tmp
  326.     pivot = arr(HighLimit).Count
  327.     i = LowLimit - 1
  328.     For j = LowLimit To HighLimit - 1
  329.         tmp = arr(j).Count - pivot
  330.         If (tmp >= 0) Then
  331.             i = i + 1
  332.             Swap arr(i), arr(j)
  333.         End If
  334.     Next
  335.     Swap arr(i + 1), arr(HighLimit)
  336.     Partition = i + 1
  337.  
« Last Edit: December 20, 2021, 11:27:59 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: Binary Sequence Predictor "game"?
« Reply #22 on: December 19, 2021, 03:25:23 pm »
Press LEFT or RIGHT as randomly as you can.

Code: QB64: [Select]
  1.  
  2. Screen _NewImage(120, 40)
  3.  
  4. ' Version: 19
  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 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 1 'UBound(TestData)
  66.  
  67.     GuessPredicted = -1
  68.     GuessesCorrect = 0
  69.     GuessesTotal = 0
  70.     GuessStreak = 0
  71.     GuessStreakMax = 0
  72.  
  73.     For n = 1 To 9999 '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 "I predicted "; _Trim$(Str$(GuessPredicted)); " and you typed "; Right$(TheString, 1); "."
  118.             If (GuessPredicted = Val(Right$(TheString, 1))) Then
  119.                 Print "I am RIGHT this round."
  120.                 GuessesCorrect = GuessesCorrect + 1
  121.                 GuessStreak = GuessStreak + 1
  122.                 If (GuessStreak > GuessStreakMax) Then GuessStreakMax = GuessStreak
  123.                 Grade(n, 2) = 1
  124.             Else
  125.                 Print "I am WRONG this round."
  126.                 GuessStreak = 0
  127.                 Grade(n, 2) = 0
  128.             End If
  129.             GuessesTotal = GuessesTotal + 1
  130.             Grade(n, 1) = GuessesCorrect / GuessesTotal
  131.         End If
  132.  
  133.         If (GuessesTotal > 0) Then
  134.             Print
  135.             Print "I'm on a "; _Trim$(Str$(GuessStreak)); "-round winning streak."
  136.             Print "My best streak has been "; _Trim$(Str$(GuessStreakMax)); "."
  137.             If (GuessesTotal <> 0) Then
  138.                 Print "My correctness rate is "; _Trim$(Str$(Int(100 * GuessesCorrect / GuessesTotal))); "% in "; _Trim$(Str$(GuessesTotal)); " guesses."
  139.             End If
  140.         End If
  141.  
  142.         GuessPredicted = Analyze(TheString, AlphaWeight(), 0)
  143.  
  144.         Print
  145.         Print "I have made a new prediction."
  146.         Print "Press LEFT or RIGHT to test me."
  147.  
  148.         ' Draw bottom graph
  149.         If (CsrLin <= 23) Then
  150.             If (GuessesTotal <> 0) Then
  151.                 Call PrintGraph(TheString, Grade())
  152.             End If
  153.         End If
  154.  
  155.         _Delay .02
  156.         _Display
  157.         _Limit 60
  158.     Next
  159.  
  160.     _Delay 3
  161.  
  162.  
  163. Sub InitializeModel
  164.     Dim As Integer k
  165.     For k = LBound(AlphaWeight) To UBound(AlphaWeight)
  166.         AlphaWeight(k) = 0 * k ^ 2
  167.     Next
  168.     'AlphaWeight(1) = 0
  169.     'AlphaWeight(2) = 0
  170.     'AlphaWeight(3) = 0
  171.     'AlphaWeight(4) = 0
  172.     AlphaWeight(5) = 1
  173.     'AlphaWeight(6) = 0
  174.     'AlphaWeight(7) = 0
  175.     'AlphaWeight(8) = 0
  176.     'AlphaWeight(9) = 0
  177.     'AlphaWeight(10) = 0
  178.     AlphaWeight(11) = 0
  179.     AlphaWeight(12) = 0
  180.     AlphaWeight(13) = 0
  181.  
  182. Function Analyze (TheStringIn As String, arrweight() As Double, pswitch As Integer)
  183.     Dim TheReturn As Integer
  184.     Dim As Integer n
  185.     Dim As Double r, j, k
  186.     Dim StringPhase(UBound(arrweight)) As String
  187.     Dim Partialguess(LBound(arrweight) To UBound(arrweight), 2) As Double
  188.  
  189.     StringPhase(1) = TheStringIn
  190.     'For n = 2 To UBound(StringPhase) ' Uncomment for phase analysis.
  191.     'StringPhase(n) = Right$(StringPhase(n - 1), Len(StringPhase(n - 1)) - 1) + Left$(StringPhase(n - 1), 1)
  192.     'Next
  193.  
  194.     ' Initialize partial results.
  195.     For n = LBound(Partialguess) To UBound(Partialguess)
  196.         Partialguess(n, 1) = -999
  197.     Next
  198.  
  199.     If (pswitch = 1) Then
  200.         Print
  201.         For n = 1 To _Width
  202.             Print "-";
  203.         Next
  204.         Print
  205.     End If
  206.  
  207.     If (arrweight(1) <> 0) Then Call CreateHisto(StringPhase(), 1, Alphabet1())
  208.     If (arrweight(2) <> 0) Then Call CreateHisto(StringPhase(), 2, Alphabet2())
  209.     If (arrweight(3) <> 0) Then Call CreateHisto(StringPhase(), 3, Alphabet3())
  210.     If (arrweight(4) <> 0) Then Call CreateHisto(StringPhase(), 4, Alphabet4())
  211.     If (arrweight(5) <> 0) Then Call CreateHisto(StringPhase(), 5, Alphabet5())
  212.     If (arrweight(6) <> 0) Then Call CreateHisto(StringPhase(), 6, Alphabet6())
  213.     If (arrweight(7) <> 0) Then Call CreateHisto(StringPhase(), 7, Alphabet7())
  214.     If (arrweight(8) <> 0) Then Call CreateHisto(StringPhase(), 8, Alphabet8())
  215.     If (arrweight(9) <> 0) Then Call CreateHisto(StringPhase(), 9, Alphabet9())
  216.     If (arrweight(10) <> 0) Then Call CreateHisto(StringPhase(), 10, Alphabet10())
  217.     If (arrweight(11) <> 0) Then Call CreateHisto(StringPhase(), 11, Alphabet11())
  218.     If (arrweight(12) <> 0) Then Call CreateHisto(StringPhase(), 12, Alphabet12())
  219.     If (arrweight(13) <> 0) Then Call CreateHisto(StringPhase(), 13, Alphabet13())
  220.  
  221.     If (pswitch = 1) Then ' Set the last argument >=1 to print stats for that histogram.
  222.         If ((Len(TheStringIn) >= 1) And (arrweight(1) <> 0)) Then Call PrintHisto(Alphabet1(), 0)
  223.         If ((Len(TheStringIn) >= 2) And (arrweight(2) <> 0)) Then Call PrintHisto(Alphabet2(), 0)
  224.         If ((Len(TheStringIn) >= 3) And (arrweight(3) <> 0)) Then Call PrintHisto(Alphabet3(), 0)
  225.         If ((Len(TheStringIn) >= 4) And (arrweight(4) <> 0)) Then Call PrintHisto(Alphabet4(), 0)
  226.         If ((Len(TheStringIn) >= 5) And (arrweight(5) <> 0)) Then Call PrintHisto(Alphabet5(), 4)
  227.         If ((Len(TheStringIn) >= 6) And (arrweight(6) <> 0)) Then Call PrintHisto(Alphabet6(), 0)
  228.         If ((Len(TheStringIn) >= 7) And (arrweight(7) <> 0)) Then Call PrintHisto(Alphabet7(), 0)
  229.         If ((Len(TheStringIn) >= 8) And (arrweight(8) <> 0)) Then Call PrintHisto(Alphabet8(), 0)
  230.         If ((Len(TheStringIn) >= 9) And (arrweight(9) <> 0)) Then Call PrintHisto(Alphabet9(), 0)
  231.         If ((Len(TheStringIn) >= 10) And (arrweight(10) <> 0)) Then Call PrintHisto(Alphabet10(), 0)
  232.         If ((Len(TheStringIn) >= 11) And (arrweight(11) <> 0)) Then Call PrintHisto(Alphabet11(), 0)
  233.         If ((Len(TheStringIn) >= 12) And (arrweight(12) <> 0)) Then Call PrintHisto(Alphabet12(), 0)
  234.         If ((Len(TheStringIn) >= 13) And (arrweight(13) <> 0)) Then Call PrintHisto(Alphabet13(), 0)
  235.         Print
  236.     End If
  237.  
  238.     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.
  239.     If ((Len(TheStringIn) >= 2) And (arrweight(2) <> 0)) Then Call MakeGuess(TheStringIn, 2, Alphabet2(), Partialguess(), 0)
  240.     If ((Len(TheStringIn) >= 3) And (arrweight(3) <> 0)) Then Call MakeGuess(TheStringIn, 3, Alphabet3(), Partialguess(), 0)
  241.     If ((Len(TheStringIn) >= 4) And (arrweight(4) <> 0)) Then Call MakeGuess(TheStringIn, 4, Alphabet4(), Partialguess(), 0)
  242.     If ((Len(TheStringIn) >= 5) And (arrweight(5) <> 0)) Then Call MakeGuess(TheStringIn, 5, Alphabet5(), Partialguess(), pswitch)
  243.     If ((Len(TheStringIn) >= 6) And (arrweight(6) <> 0)) Then Call MakeGuess(TheStringIn, 6, Alphabet6(), Partialguess(), 0)
  244.     If ((Len(TheStringIn) >= 7) And (arrweight(7) <> 0)) Then Call MakeGuess(TheStringIn, 7, Alphabet7(), Partialguess(), 0)
  245.     If ((Len(TheStringIn) >= 8) And (arrweight(8) <> 0)) Then Call MakeGuess(TheStringIn, 8, Alphabet8(), Partialguess(), 0)
  246.     If ((Len(TheStringIn) >= 9) And (arrweight(9) <> 0)) Then Call MakeGuess(TheStringIn, 9, Alphabet9(), Partialguess(), 0)
  247.     If ((Len(TheStringIn) >= 10) And (arrweight(10) <> 0)) Then Call MakeGuess(TheStringIn, 10, Alphabet10(), Partialguess(), 0)
  248.     If ((Len(TheStringIn) >= 11) And (arrweight(11) <> 0)) Then Call MakeGuess(TheStringIn, 11, Alphabet11(), Partialguess(), 0)
  249.     If ((Len(TheStringIn) >= 12) And (arrweight(12) <> 0)) Then Call MakeGuess(TheStringIn, 12, Alphabet12(), Partialguess(), 0)
  250.     If ((Len(TheStringIn) >= 13) And (arrweight(13) <> 0)) Then Call MakeGuess(TheStringIn, 13, Alphabet13(), Partialguess(), 0)
  251.     If (pswitch = 1) Then Print
  252.  
  253.     If (pswitch = 1) Then
  254.         Print "Thinking:";
  255.         For k = LBound(Partialguess) To UBound(Partialguess)
  256.             If (Partialguess(k, 1) <> -999) Then
  257.                 Print Partialguess(k, 1);
  258.             Else
  259.                 Print "_ ";
  260.             End If
  261.         Next
  262.         Print
  263.     End If
  264.  
  265.     j = 0
  266.     r = 0
  267.  
  268.     ' Weighted average calculation
  269.     For k = UBound(Partialguess) To LBound(Partialguess) Step -1
  270.         If (Partialguess(k, 1) <> -999) Then
  271.             r = r + arrweight(k) * Partialguess(k, 1)
  272.             j = j + arrweight(k)
  273.         End If
  274.     Next
  275.     If (j <> 0) Then
  276.         r = r / j
  277.     End If
  278.  
  279.     If (pswitch = 1) Then Print "Predicting:  "; _Trim$(Str$(r))
  280.  
  281.     If (r > .5) Then
  282.         r = 1
  283.     Else
  284.         r = 0
  285.     End If
  286.  
  287.     If (pswitch = 1) Then
  288.         Print "Rounding to: "; _Trim$(Str$(r))
  289.     End If
  290.  
  291.     If (pswitch = 1) Then
  292.         For n = 1 To _Width
  293.             Print "-";
  294.         Next
  295.         Print
  296.     End If
  297.  
  298.     TheReturn = r
  299.     Analyze = TheReturn
  300.  
  301. Sub MakeGuess (TheStringIn As String, wid As Integer, arralpha() As LetterBin, arrguess() As Double, pswitch As Integer)
  302.     Dim TheReturn As Double
  303.     Dim As Integer j, k, n
  304.     TheReturn = 0
  305.     j = 1
  306.     k = 0
  307.     For n = 1 To UBound(arralpha)
  308.         If (Left$(arralpha(n).Signature, wid - 1) = Right$(TheStringIn, wid - 1)) Then
  309.             If (arralpha(n).Count >= j) Then
  310.                 If (pswitch = 1) Then Print "Order-"; Right$("0" + _Trim$(Str$(wid)), 2); " guess: "; arralpha(n).Signature; " . "; _Trim$(Str$(arralpha(n).Count))
  311.                 TheReturn = TheReturn + Val(Right$(arralpha(n).Signature, 1))
  312.                 k = k + 1
  313.                 j = arralpha(n).Count
  314.             End If
  315.         End If
  316.     Next
  317.     If (k <> 0) Then
  318.         TheReturn = TheReturn / k
  319.     Else
  320.         TheReturn = .5
  321.     End If
  322.     arrguess(wid, 1) = TheReturn
  323.     arrguess(wid, 2) = j
  324.  
  325. Sub CreateHisto (arrfinger() As String, wid As Integer, arralpha() As LetterBin)
  326.     Dim As Integer j, k, n
  327.     For n = 1 To UBound(arralpha)
  328.         arralpha(n).Count = 0
  329.     Next
  330.     ' Uncomment this loop to enable phase analysis.
  331.     'For j = 1 To wid
  332.     j = 1
  333.     For k = 1 To Len(arrfinger(j)) - (Len(arrfinger(j)) Mod wid) Step wid
  334.         For n = 1 To UBound(arralpha)
  335.             If (Mid$(arrfinger(j), k, wid) = 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, wid As Integer)
  344.     Dim As Integer j, n
  345.     If (wid > 0) Then
  346.         If (wid > UBound(arr)) Then
  347.             j = UBound(arr)
  348.         Else
  349.             j = wid
  350.         End If
  351.         Print "Histogram: "; _Trim$(Str$(UBound(arr))); "-letter regroup, showing top "; _Trim$(Str$(wid))
  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
  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 = 2 To Len(TheString)
  369.         g = Int(j * f)
  370.         If (g = 0) Then g = 1
  371.         Locate _Height - 5 - Int(10 * arrgrade(j, 1)), g
  372.         If (arrgrade(j, 2) = 1) Then
  373.             Print Chr$(251)
  374.         Else
  375.             Print "x"
  376.         End If
  377.     Next
  378.  
  379. Sub NewAlphabet (arrold() As LetterBin, arrnew() As LetterBin)
  380.     Dim As Integer j, k, n
  381.     n = 0
  382.     For k = 1 To 2
  383.         For j = 1 To UBound(arrold)
  384.             n = n + 1
  385.             arrnew(n).Signature = arrold(j).Signature
  386.         Next
  387.     Next
  388.     For j = 1 To UBound(arrnew)
  389.         If (j <= UBound(arrnew) / 2) Then
  390.             arrnew(j).Signature = "0" + arrnew(j).Signature
  391.         Else
  392.             arrnew(j).Signature = "1" + arrnew(j).Signature
  393.         End If
  394.     Next
  395.  
  396. Sub QuickSort (arr() As LetterBin, LowLimit As Long, HighLimit As Long)
  397.     Dim As Long piv
  398.     If (LowLimit < HighLimit) Then
  399.         piv = Partition(arr(), LowLimit, HighLimit)
  400.         Call QuickSort(arr(), LowLimit, piv - 1)
  401.         Call QuickSort(arr(), piv + 1, HighLimit)
  402.     End If
  403.  
  404. Function Partition (arr() As LetterBin, LowLimit As Long, HighLimit As Long)
  405.     Dim As Long i, j
  406.     Dim As Double pivot, tmp
  407.     pivot = arr(HighLimit).Count
  408.     i = LowLimit - 1
  409.     For j = LowLimit To HighLimit - 1
  410.         tmp = arr(j).Count - pivot
  411.         If (tmp >= 0) Then
  412.             i = i + 1
  413.             Swap arr(i), arr(j)
  414.         End If
  415.     Next
  416.     Swap arr(i + 1), arr(HighLimit)
  417.     Partition = i + 1
  418.  
  419. 'Function Pathological$ (TheSeed As String, TheLength As Integer)
  420. '    Dim TheReturn As String
  421. '    TheReturn = TheSeed
  422. '    Dim p
  423. '    Do
  424. '        Cls
  425. '        Locate 1, 1
  426. '        Print TheReturn;
  427. '        p = Analyze(TheReturn, 0)
  428. '        If (p = 1) Then
  429. '            TheReturn = TheReturn + "0"
  430. '        Else
  431. '            TheReturn = TheReturn + "1"
  432. '        End If
  433. '    Loop Until Len(TheReturn) = TheLength
  434. '    Pathological$ = TheReturn
  435. 'End Function
  436.  
  437. Function LoadTestData (alwayszero As Integer)
  438.     Dim n As Integer
  439.     n = alwayszero
  440.  
  441.     '''
  442.     ' Percussive cases:
  443.     '''
  444.     n = n + 1: TestData(n) = "1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111"
  445.     n = n + 1: TestData(n) = "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
  446.     n = n + 1: TestData(n) = "0101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101"
  447.     n = n + 1: TestData(n) = "1010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010"
  448.     n = n + 1: TestData(n) = "0001110011000111001100011100110001110011000111001100011100110001110011000111001100011100110001110011000111001100011100110001110011000111001100011100110001110011"
  449.     n = n + 1: TestData(n) = "0100010111010001011101000101110100010111010001011101000101110100010111010001011101000101110100010111010001011101000101110100010111010001011101000101110100010111"
  450.  
  451.     '''
  452.     ' Human samples:
  453.     '''
  454.     ' (from Keybone)
  455.     n = n + 1: TestData(n) = "101010101010101010101001010101010101001010111001010101010101010101010100010101010101010100101001010101001100101010001010100101010100101010100101010101010101010011011110010101010100100101010110010011001010011001010100010100101010010101010101010010101010101010010101001010101010100110010101010100101010101010011001001010100101010010101010100101010010101001010100101001010010101010111010100110011001010101010100110101001010101010100101001010111010101010101010100101001010101010010101010101001010101001010101001010100101010100101010010101010101001010101001010101010101001010101001010100101010101010010101010010010101010101010101010010100101010101001010100101001010101001111101010101010100101010110011001010101010101010110101010101101010101010100101010010101010010101010101101110010101001010101010110010100101010101001011010101010100110101010100101010010101010100101010101001010101010101001010101010011010101010101110110100101010111010101011011001011001010101001010101010101010101010011001010101010100101010101010101010010100101"
  456.     ' (from Keybone)
  457.     n = n + 1: TestData(n) = "0101110101100011010100101011001110001011001010001110101111010100111011100100101001010011110101101000101010001010101111001010111010101010100001010101000101101100101111101010010101110110111001000101000011010101010001001001001111101011101010100010110101110101100000101010101110111010100100100001110111100101011110101010001010001110010110111110110010101001001011101000101001011100011101000010101010101101010010110100101101000101111010101110111001010011101111010101000010101111100010101011110101011011110100001010110"
  458.     ' (from Loudar)
  459.     n = n + 1: TestData(n) = "1011001010010100100100110010101010101001010101010101011010010101001010101001010010100110101011010101010101011010101101010101010101010010110101010101100101010101010110101101011010010101010010100110101101001010110101011010010101101010110100101111010101010011011011010010110101010010110100101101010100101011010010101001010101010001011101011010010101011100111010010001101011110010011010001011100110101010010011010101001001010010000101010110001"
  460.     ' (from Luke)
  461.     n = n + 1: TestData(n) = "01100101001010001100001101101111011010010101010110110101001000001111001111110101000101111011010101111101010101101010101001010101011000010101010101001011010100110100110100110011010101010101110101010111111101011010100000001101111000010111000110111001000010100001101010110100000111101011111100001011001010110010110"
  462.     ' (from Sarafromct)
  463.     n = n + 1: TestData(n) = "10101010101011101000011101010111010101010101100111001010100111100001011011110101000001111010101101010000001111110011111110111101110111001110110010000100010101010101010100101011010110101010101010101001000000001111110000011110101010101010100010101110101010101101111111111111111111101010101010101000000"
  464.     ' (from Spriggs)
  465.     n = n + 1: TestData(n) = "10111010101010101010101001010101010101001010101001010101010101010101010101010101010101010101010101010101001010100100100101010101010101001010100101010101010100101010100101010101010101010101001010010110010101010010101010101010101010101010100101001001001010101010101010101010101001010101001001101010010"
  466.     ' (from Spriggs)
  467.     n = n + 1: TestData(n) = "11111011110100101011111111110100000011011110101100111100111111110111101110100111100110011111110101111111010111101111100111110111111111111011100111110111111110010000101011111001110101101010110111110"
  468.     ' (from Hotpants)
  469.     n = n + 1: TestData(n) = "01010100011001010010101010101010101000110101010111101010100100011010101010100100101110010010010100001010101001010101010110010001001011000100100110101001001001010000000001010101101111101001010100010101001001010101000100101001100100010011010101010101010111010010101011101011011010110100100010010100100100010010001001"
  470.  
  471.     LoadTestData = n
  472.  
  473.  

Reach much more at: http://barnes.x10host.com/pages/Binary-Analyzer.php
« Last Edit: December 20, 2021, 11:23:29 am by STxAxTIC »
You're not done when it works, you're done when it's right.

Marked as best answer by STxAxTIC on December 20, 2021, 06:15:12 am

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
Re: Binary Sequence Predictor "game"?
« Reply #23 on: December 20, 2021, 11:09:14 am »
Here's an inform version. I love it.

 
screenshot.png


(There might be something buggy about the way I carried this to inform so if you're looking to study the code or study the game you should use the resources in the post directly above this ^^^)
* RandomInformGame.zip (Filesize: 1.51 MB, Downloads: 65)
« Last Edit: December 20, 2021, 11:26:08 am by STxAxTIC »
You're not done when it works, you're done when it's right.

Offline Sanmayce

  • Newbie
  • Posts: 63
  • Where is that English Text Sidekick?
    • Sanmayce's home
Re: Binary Sequence Predictor "game"?
« Reply #24 on: December 23, 2021, 03:30:25 am »
Interesting, some time ago a fellow member posted some word-guesser, my suggestion is to try something new, namely "Letter-Guesser".

Instead of zeros and ones, the game to allow writing letters in a string (it could be more space effective if the written string is placed in a box instead of a line), and in REAL-TIME, heh-heh, to guess the next letter, thus whether the previous input was words making sense, or not, it would be an useful ... auto-completion etude.

I have in my to-do list to write a phrase-guesser, deriving from millions of bi-grams (as a start), in next year.

For a long time I wanted to have (and share) a simple application allowing typing (in kinda search box) English words, and the word being currently typed to be PAIRED with the previous one, thus forming a bi-gram being matched versus some big-ass bi-gram corpus. Then when, for example, I type "Sylvester St" the predictor to suggest few bi-grams, thus people who are unaware how the family name of the beloved actor is, would be saved from the shame.
Here is what Google suggests when typing "Sy":

 
predict.png


Oh, and to boost its practicalness, if the user started on a wrong foot e.g. "Silvestor St" then the predictor to be ready to fire the correct "Sylvester Stallone" - that is to be capable of detecting "errors" in the word before last one as well.
« Last Edit: December 23, 2021, 03:39:01 am by Sanmayce »
He learns not to learn and reverts to what all men pass by.

Offline DANILIN

  • Forum Regular
  • Posts: 128
    • Danilin youtube
Re: Binary Sequence Predictor "game"?
« Reply #25 on: December 23, 2021, 06:52:50 am »
please synthesize minimum 25000 values of 0 & 1
no matter: in a row or in a column
and having packed them into an archive
and place them in topic
to check for binomial distribution in several parts
Russia looks world from future. big data is peace data.
https://youtube.com/playlist?list=PLBBTP9oVY7IagpH0g9FNUQ8JqmHwxDDDB
i never recommend anything to anyone and always write only about myself

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
Re: Binary Sequence Predictor "game"?
« Reply #26 on: December 23, 2021, 03:45:12 pm »
Quote
please synthesize minimum 25000 values of 0 & 1

I hope you see the essence of this this game is to produce data by hand, so I was actually wishing you would generate 25,000 events *for* me. It's Christmas, what do ya think?

You may be able to check for elements of non-randomness using binomial distribution or other statistical methods but that's a far cry from what this code can do. We need a good Russian translator around here, I have a feeling you'd like this but it's hard to carry on with you due to my very poor understanding of Russian.
You're not done when it works, you're done when it's right.

Offline DANILIN

  • Forum Regular
  • Posts: 128
    • Danilin youtube
Re: Binary Sequence Predictor "game"?
« Reply #27 on: December 23, 2021, 05:32:30 pm »
you understand correctly what I am writing
and I check myself through translation of translation

MS Excel formula
=randbetween(0;1)

and stretch down

but MS Word translation from column to row: replacement
^p
on clear string

5 KB = 25'000 (0\1)
 


Binomial Logarithmic Integral Pyramidal Distribution
BLIP distribution of Random numbers

25000 0\1 from array above have been investigated
and it is possible to investigate your numbers and 0 and 1

Code: [Select]
.984375 second              25396  in second 
 25000         elements     

 THEORY        Average       BIG           EVEN

 6250          6347          6348          6347
 3125          3058          3057          3059
 1562          1548          1549          1548
 781           774           774           774
 390           388           388           388
 195           194           194           194
 97            92            92            92
 48            51            51            51
 24            23            23            23
 12            15            15            15
 6             11            11            11
 3             5             5             5

Practical distributions correspond to theoretical ones
so random sequence is qualitative
and it is possible to study patterns of different sequences

Feature of program: index of indixes p(f(i)) & q(m(i))

Since 2019 & 1993

Code: QB64 $NOPREFIX: [Select]
  1. 'dablip25.bas
  2. n = 25000: Randomize Timer
  3. Dim b(n), d(n), e(n), f(n)
  4. Dim j(n), k(n), m(n), p(12), q(12)
  5. tb = Timer: s = 0
  6. Open "25000.txt" For Input As #1
  7. For i = 1 To n: Locate 1, 1: Print i, ,: Input #1, b(i): Next
  8. Locate 1, 1: Print " THEORY        Average       BIG           EVEN "
  9.  
  10. For i = 2 To n-1: s = s+b(i): m = s/i
  11.  
  12.     If b(i) < m Then d(i) = 0 Else d(i) = 1
  13.     If (b(i) Mod 2) = 0 Then j(i) = 0 Else j(i) = 1
  14.  
  15.     If d(i) = d(i-1) Then e(i) = e(i-1)+1 Else e(i) = 0
  16.     If e(i) = 0 Then f(i) = e(i-1) Else f(i) = 12
  17.     If f(i) > 12 Then f(i) = 12
  18.  
  19.     If j(i) = j(i-1) Then k(i) = k(i-1)+1 Else k(i) = 0
  20.     If k(i) = 0 Then m(i) = k(i-1) Else m(i) = 12
  21.     If m(i) > 12 Then m(i) = 12
  22.  
  23.     p(f(i)) = p(f(i))+1: q(m(i)) = q(m(i))+1
  24.  
  25.     If (i Mod 1000) = 0 Then Locate 3, 1: Print i, " from ", n, Int(100 * i/n); " %",
  26.  
  27. Locate 3, 1: For t = 1 To 12
  28.     Print Int(n/(2^(t+1))), Int((p(t-1)+q(t-1))/2), p(t-1), q(t-1)
  29.  
  30. Print: Print Timer-tb; "second", Int(n/(Timer-tb)); " in second  "
  31. Print n, " elements ",
« Last Edit: December 25, 2021, 10:42:03 am by DANILIN »
Russia looks world from future. big data is peace data.
https://youtube.com/playlist?list=PLBBTP9oVY7IagpH0g9FNUQ8JqmHwxDDDB
i never recommend anything to anyone and always write only about myself

Offline DANILIN

  • Forum Regular
  • Posts: 128
    • Danilin youtube
Re: Binary Sequence Predictor "game"?
« Reply #28 on: December 30, 2021, 11:09:54 pm »
? have you calculated 25ooo 0\1 ?
from message above: 25000.zip
Russia looks world from future. big data is peace data.
https://youtube.com/playlist?list=PLBBTP9oVY7IagpH0g9FNUQ8JqmHwxDDDB
i never recommend anything to anyone and always write only about myself

Offline DANILIN

  • Forum Regular
  • Posts: 128
    • Danilin youtube
Re: Binary Sequence Predictor "game"?
« Reply #29 on: February 17, 2022, 09:25:44 am »
shuffle and make sure that number does not take its place
so far without control has array become binomially better

we create an array of numbers in a row
and in 1 pass we rearrange serial number and a random number
and if numbers of rearranged ones match: spinning line is my handwriting

check array and if there are numbers in their places:
we count number and write array as defective
marking matched ones with a minus sign

first and last numbers are displayed on screen but it is possible to write everything to file

how to copy text results from window is unknown therefore:
picture shows: 9 numbers were qualitatively shuffled from 6th attempt
in 0 seconds

next I plan to calculate whether sequence has become truly random
and apparently I will have to switch to index indexes as excel cells

 
tas_xod.PNG


+ update by 10%
result is visible if saved to disk or ram disk
between cells at least 10%
and number of repeated shuffles: up to 25% of array length

Code: QB64: [Select]
  1. a = 100: DIM d(a): x=0: k=0: t$=CHR$(9): RANDOMIZE TIMER 'tas_ten.bas
  2. PRINT ,: FOR i = 1 TO a: d(i)=i: NEXT
  3. FOR i = 1 TO 5: PRINT d(i);: NEXT: PRINT ,
  4. FOR i = a-3 TO a: PRINT d(i);: NEXT: z = TIMER
  5. OPEN "b:/control.txt" FOR OUTPUT AS #1 ' ram disk
  6. WHILE x < 1
  7.     v = 0: FOR i = 1 TO a
  8.        1 m = INT(RND*a)+1: IF ABS(d(i)-d(m)) < .1*a THEN v = v+1: GOTO 1
  9.         PRINT #1, ABS(d(i)-d(m)); t$; d(i); t$; d(m); t$; i; t$; m; t$; d(i)/d(m); t$; d(m)/d(i)
  10.         t = d(i): d(i) = d(m): d(m) = t
  11.     NEXT
  12.  
  13.     s = 0: FOR i = 1 TO a
  14.         IF d(i) = i THEN s = s+1
  15.     NEXT
  16.    5 k = k+1: PRINT: PRINT s; v,: IF s=0 THEN x = x+1
  17.  
  18.     FOR i = 1 TO 5
  19.         IF d(i) = i THEN PRINT -d(i); ELSE PRINT d(i);
  20.     NEXT: PRINT ,
  21.     FOR i = a-3 TO a
  22.         IF d(i) = i THEN PRINT -d(i); ELSE PRINT d(i);
  23.     NEXT
  24. WEND: PRINT: PRINT "    = "; k, TIMER-z: END

result control: open in notepad and search 1.0
as ratio is less than 10% and desired is missing
this means that elements are shuffled at a distance of at least 10% of array from each other

Code: [Select]
41 70 29 91 18 2.413793 .4142857
 59 24 83 92 38 .2891566 3.458333
 14 32 46 93 44 .6956522 1.4375
 23 10 33 94 88 .3030303 3.3
 29 19 48 95 36 .3958333 2.526316
 11 41 30 96 11 1.366667 .7317073
 38 1 39 97 21 2.564103E-02 39
 60 26 86 98 55 .3023256 3.307692
 17 4 21 99 58 .1904762 5.25
 26 100 74 100 59 1.351351 .74

returning to topic: binary arise if you identify parity and odd
and comparing relative average: less or more
« Last Edit: February 17, 2022, 04:52:42 pm by DANILIN »
Russia looks world from future. big data is peace data.
https://youtube.com/playlist?list=PLBBTP9oVY7IagpH0g9FNUQ8JqmHwxDDDB
i never recommend anything to anyone and always write only about myself