Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: bplus on April 20, 2019, 11:03:39 pm

Title: Fun with n-Grams
Post by: bplus on April 20, 2019, 11:03:39 pm
Code: QB64: [Select]
  1. _TITLE "Ngrams 1" 'started 2019-04-20 B+
  2. ' ref: Daniel Shiffman Coding Challenge #42.1 Markov Chains Part 1
  3. ' [youtube]https://www.youtube.com/watch?v=eGFJ8vugIWA&list=PLRqwX-V7Uu6ZiZxtDDRCi6uhfTH4FilpH[/youtube]&index=52
  4.  
  5. ' Basically take some text, collect all unique nGrams of a certain length, the gram.
  6. ' Collect all the letters that follow a gram in the text in nextChar string.
  7. ' Create a new random text with same nGrams based on random selection of following chars.
  8.  
  10. SCREEN _NEWIMAGE(800, 720, 32)
  12.  
  13. 'setup the grams
  14. CONST ngLen = 6
  15. TYPE nGramType
  16.     gram AS STRING * NGLEN
  17.     nextChar AS STRING
  19. REDIM SHARED grams(1 TO 1000) AS nGramType, nextGI
  20. nextGI = 1
  21.  
  22. 'get some text, this might be fun
  23. OPEN "Pete replies.txt" FOR INPUT AS #1
  25.     LINE INPUT #1, t$
  26.     txt$ = txt$ + t$
  29. 'PRINT txt$
  30.  
  31. 'Load the grams array
  32. FOR i = 1 TO LEN(txt$) - ngLen - 1
  33.     ngCandidate$ = MID$(txt$, i, ngLen)
  34.     'PRINT "ngCandidate$ "; ngCandidate$
  35.     found = find(ngCandidate$)
  36.     'PRINT "found "; found
  37.     IF found = 0 THEN
  38.         'add to grams
  39.         grams(nextGI).gram = ngCandidate$
  40.         grams(nextGI).nextChar = MID$(txt$, i + ngLen, 1)
  41.         'sort grams
  42.         QSort 1, nextGI
  43.         'FOR i = 1 TO nextGI
  44.         '    PRINT grams(i).gram, grams(i).nextChar
  45.         'NEXT
  46.         nextGI = nextGI + 1
  47.         IF nextGI > UBOUND(grams) THEN REDIM _PRESERVE grams(1 TO UBOUND(grams) + 1000) AS nGramType
  48.     ELSE
  49.         grams(found).nextChar = grams(found).nextChar + "~" + MID$(txt$, i + ngLen, 1)
  50.     END IF
  51.     'INPUT "OK press enter..."; wate$
  53. 'check load
  54. 'FOR i = 1 TO nextGI
  55. '    PRINT grams(i).gram, grams(i).nextChar
  56. '    IF i MOD 20 = 0 THEN
  57. '        PRINT: INPUT "OK, press enter...", wate$
  58. '        CLS
  59. '    END IF
  60. 'NEXT
  61.  
  62. 'generate random text
  63. 'find a gram that starts with a Capital letter, dang it's always the same start!
  64. i = INT(RND * (nextGI - 1)) + 1
  65. WHILE rtxt$ = ""
  66.     IF INSTR("ABCDEFGHIJKLMNOPQRSTUVWXYZ", LEFT$(grams(i).gram, 1)) > 0 THEN
  67.         rtxt$ = grams(i).gram
  68.         IF LEN(grams(i).nextChar) = 1 THEN
  69.             rtxt$ = rtxt$ + grams(i).nextChar
  70.         ELSE
  71.             REDIM select$(0)
  72.             Split1000 grams(i).nextChar, "~", select$()
  73.             r = INT(RND * (UBOUND(select$) + 1))
  74.             rtxt$ = rtxt$ + select$(r)
  75.         END IF
  76.     END IF
  77.     i = i + 1
  78.     IF i > nextGI - 1 THEN i = 10
  80.  
  81. 'PRINT rtxt$, LEN(rtxt$)
  82. WHILE LEN(rtxt$) < 4000
  83.     g$ = MID$(rtxt$, LEN(rtxt$) - ngLen + 1)
  84.     found = find(g$)
  85.     IF found > 0 THEN
  86.         IF LEN(grams(found).nextChar) = 1 THEN
  87.             rtxt$ = rtxt$ + grams(found).nextChar
  88.         ELSE
  89.             REDIM select$(0)
  90.             Split1000 grams(found).nextChar, "~", select$()
  91.             r = INT(RND * (UBOUND(select$) + 1))
  92.             rtxt$ = rtxt$ + select$(r)
  93.         END IF
  94.     ELSE
  95.         rtxt$ = rtxt$ + " "
  96.     END IF
  98. PRINT rtxt$
  99.  
  100. SUB QSort (Start, Finish) 'shownK needs to be shared array
  101.     i = Start
  102.     j = Finish
  103.     m$ = grams(INT((i + j) / 2)).gram
  104.     WHILE i <= j
  105.         WHILE grams(i).gram < m$
  106.             i = i + 1
  107.         WEND
  108.         WHILE grams(j).gram > m$
  109.             j = j - 1
  110.         WEND
  111.         IF i <= j THEN
  112.             SWAP grams(i), grams(j)
  113.             i = i + 1
  114.             j = j - 1
  115.         END IF
  116.     WEND
  117.     IF j > Start THEN QSort Start, j
  118.     IF i < Finish THEN QSort i, Finish
  120.  
  121. FUNCTION find (x$)
  122.     IF nextGI = 1 THEN EXIT FUNCTION
  123.     low = 1: hi = nextGI - 1
  124.     WHILE low <= hi
  125.         test = (low + hi) \ 2
  126.         IF grams(test).gram = x$ THEN
  127.             find = test: EXIT FUNCTION
  128.         ELSE
  129.             IF grams(test).gram < x$ THEN low = test + 1 ELSE hi = test - 1
  130.         END IF
  131.     WEND
  133.  
  134. 'notes: REDIM the array(0) to be loaded before calling Split '<<<<<<<<<<<<<<<<<<<<<<< IMPORTANT!!!!
  135. SUB Split1000 (mystr AS STRING, delim AS STRING, arr() AS STRING)
  136.     ' bplus modifications of Galleon fix of Bulrush Split reply #13
  137.     ' http://xmaxw.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index.php?topic=1612.0
  138.     ' this sub further developed and tested here: \test\Strings\Split test.bas
  139.     DIM copy AS STRING, p AS LONG, curpos AS LONG, arrpos AS LONG, dpos AS LONG
  140.  
  141.     copy = mystr 'make copy since we are messing with mystr when the delimiter is a space
  142.  
  143.     'special case if delim is space, probably want to remove all excess space
  144.     IF delim = " " THEN
  145.         copy = RTRIM$(LTRIM$(copy))
  146.         p = INSTR(copy, "  ")
  147.         WHILE p > 0
  148.             copy = MID$(copy, 1, p - 1) + MID$(copy, p + 1)
  149.             p = INSTR(copy, "  ")
  150.         WEND
  151.     END IF
  152.     curpos = 1
  153.     arrpos = 0
  154.     LD = LEN(delim) 'mod
  155.     dpos = INSTR(curpos, copy, delim)
  156.     DO UNTIL dpos = 0
  157.         arr(arrpos) = MID$(copy, curpos, dpos - curpos)
  158.         arrpos = arrpos + 1
  159.         IF arrpos > UBOUND(arr) THEN REDIM _PRESERVE arr(UBOUND(arr) + 1000) AS STRING
  160.         curpos = dpos + LD
  161.         dpos = INSTR(curpos, copy, delim)
  162.     LOOP
  163.     arr(arrpos) = MID$(copy, curpos)
  164.     REDIM _PRESERVE arr(arrpos) AS STRING 'need this line? YES to get the ubound correct
  166.  
  167.  

"Pete replies.txt" file, copy and paste into file or find your own text to play with.
Quote
I'm just glad I can count on The Rho to fill in for me when I'm too busy not being a misogynist to reply to a post. Men and women are different biologically and psychologically, period. Women don't gravitate to programming like men do Probably math has something to do with that, but it probably goes deeper. It's just fun to point out the obvious math part. I ran into this same question when I coached golf. How can we get more girls interested in the game? Well, it's simple, change the game. Girls wanted it to be more a social outing. Guys, on the other hand, play real golf! Kidding aside, guys like playing more to compete. They socialize, too, but to a lesser degree. It's more about shot-making than. I mean you could probably pick 10 similarities men and women golfers have in common, but they would rank radically different in importance. If any girls or women want to post or visit the forums, great, but be advised it is male dominate, period. That's not going to change unless more females get interested in coding.  Frankly, if enough females wee coding back in the QBasic age, I would have put one in charge of a ladies sub-forum. I wouldn't exclude males from posting, but I would want to see it develop in a way that was somehow different than the predominately, nearly all male forum. It's a bit of a tangent, but all this parity BS of today is not for the sake of equality, it's so liberals can suck votes out of simpletons to keep their liberal communist dream for power alive and moving forward. It's a lot less less work than coming up with actual beneficial ideas for a free society, because then there would be less pathetic losers looking for handouts. In the U.S., already more than 50% of the workforce is female; so now Bolsheviks want to try and make people believe there is income inequality. Well duh. If most of the workforce was male before, there is this little thing called seniority that means males, who have been at the job longer, are being paid higher. When that changes, either something else will replace it like women aren't getting enough respect, or some other BS "inequality" topic will be all the fake news talks about 24/7. Anyway, my gut tells me Qwerkey is just asking about ways to get more females interested in coding, for non-political reasons. Men and women are different, and it's nice to have a larger number of your gender to relate to on social platforms. There are other good reasons, too, such as the practical aspects of knowing how to program, including good jobs. What's cool about places today that are free capitalistic governments is that all of these opportunities are available, but if psychological makeup (not made by the Covergirl corporation) has anything to say about it, you'd probably have to get pretty inventive with the Woman's club concept I touched on, earlier, to make it happen. Well then so much for the fake news bozos, who would love women to think they should get involved with programming. My take on it is even if more women did, they'd be too high maintenance for most companies, requiring way too much FORTRAN before any real coding got done.

PS for creative word creation try setting
Code: QB64: [Select]
  1. CONST ngLen = 6

the gram length to a shorter 3 or 4.
Text Only | Text with Attachments