Смысл в следующем: берём два произвольных символа подряд и ищим случайным образом, с какими другими двумя символами они сочетаются в тексте. Затем берём эти новые два символа и делаем то же самое.
- Код: Выделить всё
Public Function getMarkov(lenM As Long, txt As String _
, Optional prefChrs As String) As String
'Нужно реализовать, чтобы на выходе
'симоволы из prefChrs встречались чаще
Randomize
Dim sk As Long 'до куда заполнен результирующий текст
Dim s As String, ln As Long
Dim hf As Long 'середина текста
ln = Len(txt)
hf = ln \ 2
ln = ln - 4 ' чтобы, если мы случайным образом выбираем последний знак,за ним ещё был бы хвостик.
getMarkov = Space(lenM)
Dim i As Long, k As Long
'случайным образом выбираем строку для старта
k = Int((ln - 1 + 1) * Rnd + 1)
'это должно быть начало слова, значит сдвигаемся до пробела
k = InStrRev(txt, " ", k) + 1
s = Mid$(txt, k, 2) ' берем два символа из текста
sk = 1
Mid$(getMarkov, sk, 2) = s 'и пишем их в строку результата
Do
'Int((верхняяГраница - нижняяГраница+ 1) * Rnd + нижняяГраница)
i = Int((ln - 1 + 1) * Rnd + 1) ' выбрали случайную точку в тексте
'теперь ищем от неё такое же соченание в тексте ещё где-нибудь.
If i > hf Then
k = InStr(i, txt, s) ' ищем сначала в ту сторону, которая короче
' иначе сочетания из середины выпадали бы чаще
If k = 0 Then k = InStrRev(txt, s, i) 'если не нашли, ищем в другую сторону
Else
k = InStrRev(txt, s, i)
If k = 0 Then k = InStr(i, txt, s)
End If
If k > ln Then 'если это последнее сочетание в тексте, то сочетается оно с первым в тексте
k = 1
End If
s = Mid$(txt, k + 2, 2) ' с чем именно сочетаются наши два символа.
If Len(s) = 0 Then Stop
sk = sk + 2
If sk > lenM Then Exit Do
Mid$(getMarkov, sk, 2) = s
Loop
End Function
Получается нормальный бред, качество которого меня вполне устраивает. Но осталась нерешённая проблема: как сделать, чтобы в полученном тексте чаще встречались определённый символы (скажем, "ъхзэЪХЗЭ")
Помогите идеей?
