Fun with n-Grams

[bplus]

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.  
9. RANDOMIZE TIMER
10. SCREEN _NEWIMAGE(800, 720, 32)
11. _SCREENMOVE _MIDDLE
12.  
13. 'setup the grams
14. CONST ngLen = 6
15. TYPE nGramType
16.     gram AS STRING * NGLEN
17.     nextChar AS STRING
18. END TYPE
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
24. WHILE NOT EOF(1)
25.     LINE INPUT #1, t$
26.     txt$ = txt$ + t$
27. WEND
28. CLOSE #1
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$
52. NEXT
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
79. WEND
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
97. WEND
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
119. END SUB
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
132. END FUNCTION
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
165. END SUB
166.  
167.  

"Pete replies.txt" file, copy and paste into file or find your own text to play with.

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.