09-01-2022, 01:41 PM
(09-01-2022, 12:34 PM)bplus Wrote: Hmm... I wonder if you did that with syllables and one syllable words...
well... here it is with slightly more 3 letter words.
Code: (Select All)
'babeltype_better _more 3 letter words
'
'an experiment at 1,000,000 virtual chimpanzees typing away, with a couple rules
'
' press any key to pause the program, and the spacebar to continue
' take a screen shot if you get a miracle sentence.
'
' press escape to quit
Dim vowel$(6), cm$(7), word$(10)
'dumped using cm$ for now but leaving it here just in case
vowel$(1) = "a"
vowel$(2) = "e"
vowel$(3) = "i"
vowel$(4) = "o"
vowel$(5) = "u"
vowel$(6) = "y"
cm$(1) = "t"
cm$(2) = "n"
cm$(3) = "s"
cm$(4) = "h"
cm$(5) = "r"
cm$(6) = "d"
cm$(7) = "l"
word$(1) = "the "
word$(2) = "be "
word$(3) = "and "
word$(4) = "a "
word$(5) = "of "
word$(6) = "to "
word$(7) = "in "
word$(8) = "I "
word$(9) = "you "
word$(10) = "it "
start$ = "yes"
Do
_Limit 90
r = Int(1 + Rnd * 2)
AW$ = ""
For n = 1 To r:
If start$ = "yes" Then
Select Case Int(1 + Rnd * 90)
Case 1 To 80
AW$ = AW$ + UCase$(eng$)
Case 81 To 88
AW$ = AW$ + UCase$(Chr$(97 + Int(Rnd * 26)))
Case 89, 90
W$ = word$(Int(1 + Rnd * 10))
Mid$(W$, 1, 1) = UCase$(Left$(W$, 1))
AW$ = AW$ + W$
End Select
start$ = "no"
Else
Select Case Int(1 + Rnd * 90)
Case 1 To 80
AW$ = AW$ + eng$
Case 81 To 88
AW$ = AW$ + Chr$(97 + Int(Rnd * 26))
Case 89, 90
AW$ = AW$ + word$(Int(1 + Rnd * 10))
End Select
End If
Next
r = Int(1 + Rnd * 2)
For n = 1 To r: AW$ = AW$ + vowel$(Int(1 + Rnd * 6)): Next
r = Int(1 + Rnd * 2)
For n = 1 To r
If Rnd * 6 < 4.2 Then
AW$ = AW$ + eng$
Else
AW$ = AW$ + Chr$(97 + Int(Rnd * 26))
End If
Next
If Rnd * 6 < 2.5 Then
AW$ = AW$ + vowel$(Int(1 + Rnd * 6))
If Rnd * 6 < 4.5 Then
r = Int(1 + Rnd * 2)
For n = 1 To r
If Rnd * 6 < 4.2 Then
AW$ = AW$ + eng$
Else
AW$ = AW$ + Chr$(97 + Int(Rnd * 26))
End If
Next
End If
End If
If Len(AW$) > 3 And Int(1 + Rnd * 10) < 3 Then
Select Case Int(1 + Rnd * 6)
Case 1, 2, 3
AW$ = eng$ + vowel$(1 + Int(Rnd * 6)) + eng$
Case 4, 5
AW$ = eng$ + vowel$(1 + Int(Rnd * 6)) + vowel$(1 + Int(Rnd * 6))
Case 6
AW$ = vowel$(1 + Int(Rnd * 6)) + eng$ + vowel$(1 + Int(Rnd * 6))
End Select
End If
AW$ = sift$(AW$)
Print AW$;
If Rnd * 24 < 1.5 Then
p = Int(1 + Rnd * 88)
Select Case p
Case 1 To 18
Print ",";
Case 19 To 23
Print ";";
Case 24
Print ":";
Case 25 To 75
Print ".";
start$ = "yes"
Case 76 To 83
Print "?";
start$ = "yes"
Case 84 To 88
Print "!";
start$ = "yes"
End Select
End If
Print " ";
k$ = InKey$
If k$ <> "" And k$ <> Chr$(27) Then
Do
_Limit 30
a$ = InKey$
Loop Until a$ = " "
End If
Loop Until k$ = Chr$(27)
End
Function eng$
'returns an english letter based on analysis of frequency of letters in english words
c = Int(1 + Rnd * 10000)
Select Case c
Case 1 To 1260
a$ = "e"
Case 1261 To 2197
a$ = "t"
Case 2198 To 3031
a$ = "a"
Case 3032 To 3801
a$ = "o"
Case 3802 To 4481
a$ = "n"
Case 4482 To 5152
a$ = "i"
Case 5153 To 5763
a$ = "h"
Case 5764 To 6374
a$ = "s"
Case 6375 To 6942
a$ = "r"
Case 6943 To 7366
a$ = "l"
Case 7367 To 7780
a$ = "d"
Case 7781 To 8065
a$ = "u"
Case 8063 To 8338
a$ = "c"
Case 8339 To 8591
a$ = "m"
Case 8592 To 8825
a$ = "w"
Case 8826 To 9029
a$ = "y"
Case 9030 To 9232
a$ = "f"
Case 9233 To 9424
a$ = "g"
Case 9425 To 9590
a$ = "p"
Case 9591 To 9744
a$ = "b"
Case 9745 To 9850
a$ = "v"
Case 9851 To 9937
a$ = "k"
Case 9938 To 9960
a$ = "j"
Case 9961 To 9980
a$ = "x"
Case 9981 To 9991
a$ = "q"
Case 9992 To 10000
a$ = "z"
End Select
eng$ = a$
End Function
Function sift$ (w$)
If Left$(w$, 2) = "ll" And Int(1 + Rnd * 10) < 8 Then w$ = StrReplacefirst$(w$, "ll", "l")
If InStr(w$, "ooo") Then w$ = StrReplacefirst$(w$, "ooo", "oo")
If InStr(w$, "eee") Then w$ = StrReplacefirst$(w$, "eee", "ee")
If InStr(w$, "aaa") Then w$ = StrReplacefirst$(w$, "aaa", "a")
If InStr(w$, "aa") And Int(1 + Rnd * 10) < 9 Then w$ = StrReplacefirst$(w$, "aa", "a")
If InStr(w$, "yy") Then w$ = StrReplacefirst$(w$, "yy", "y")
If InStr(w$, "ii") Then w$ = StrReplacefirst$(w$, "ii", "i")
If InStr(w$, "uuu") Then w$ = StrReplacefirst$(w$, "uuu", "u")
If InStr(w$, "uu") Then w$ = StrReplacefirst$(w$, "uu", "u")
If InStr(w$, "eoe") Then w$ = StrReplacefirst$(w$, "eoe", "eo")
If InStr(w$, "eooe") Then w$ = StrReplacefirst$(w$, "eooe", "eo")
If Left$(w$, 2) = "lp" And Int(1 + Rnd * 10) < 9 Then w$ = StrReplacefirst$(w$, "lp", "pl")
If InStr(w$, "hp") And Int(1 + Rnd * 10) < 9 Then w$ = StrReplacefirst$(w$, "hp", "ph")
If InStr(w$, "ht") And Int(1 + Rnd * 10) < 9 Then w$ = StrReplacefirst$(w$, "ht", "th")
If InStr(w$, "hg") And Int(1 + Rnd * 10) < 8 Then w$ = StrReplacefirst$(w$, "hg", "gh")
If InStr(w$, "uo") And Int(1 + Rnd * 10) < 8 Then w$ = StrReplacefirst$(w$, "uo", "ou")
If Right$(w$, 1) = "q" Then w$ = w$ + "e"
If Right$(w$, 1) = "v" Then w$ = w$ + "e"
If Right$(w$, 1) = "j" Then w$ = w$ + "e"
If Right$(w$, 2) = "lw" Then w$ = Left$(w$, Len(w$) - 2) + "wly"
If Right$(w$, 2) = "br" Then w$ = Left$(w$, Len(w$) - 2) + "ber"
If Right$(w$, 2) = "gn" Then w$ = Left$(w$, Len(w$) - 2) + "ng"
sift$ = w$
End Function
Function StrReplacefirst$ (myString$, find$, replaceWith$)
'noncase sensitive, replace the first occourence of find$ in mystring$ with replacewith$
Dim a$, b$
Dim As Long basei, i
If Len(myString$) = 0 Then Exit Function
a$ = myString$
b$ = LCase$(find$)
basei = 1
i = InStr(basei, LCase$(a$), b$)
Do While i
a$ = Left$(a$, i - 1) + replaceWith$ + Right$(a$, Len(a$) - i - Len(b$) + 1)
basei = i + Len(replaceWith$)
i = 0
Loop
StrReplacefirst$ = a$
End Function