Блог русскоязычной поддержки Wolfram Mathematica

Понятию “Цепь Маркова” исполнилось 100 лет

Перевод поста Олександра Павлыка (Oleksandr Pavlyk), Kernel Technology

Нажмите, чтобы скачать данный пост в виде ноутбука Mathematica...

Общее количество использованных в посте встроенных функций или символов: 104

Список имен используемых встроенных функций и символов в порядке их появления в коде:
WolframAlpha | List ({...}) | SetDelayed (:=) | Pattern (:) | Blank (_) | Block | Set (=) | Tally | CompoundExpression (;) | DivideBy (/=) | Part ([[…]]) | All | Length | Apply (@@) | Rule (->, ->) | Short | ToLowerCase | StringSplit | ExampleData | RegularExpression | DeleteCases | StringReplace | Import | FileNameJoin | NotebookDirectory | CharacterEncoding | Thread | CharacterRange | Alternatives (|) | Flatten | Characters | String ("...") | If | StringMatchQ | Map (/@) | N | Partition | Join | Cases | ListPlot | Table | Entropy | ImageSize | PlotMarkers | Automatic | Medium | AxesLabel | Function (&) | Style | Slot (#) | Bold | PlotLegends | MatrixForm | ReplaceAll (/.) | Outer | DiscreteMarkovProcess | Mean | FirstPassageTimeDistribution | Differences | Pick | Range | DiscretePlot | PDF | ExtentSize | Times (*, ×) | Power (^) | PlotStyle | Black | Show | Histogram | ChartStyle | Out (%) | DeleteDuplicates | PlotRange | GatherBy | Most | Graph | RuleDelayed (:>, :->) | HoldPattern | Property | DirectedEdge | SparseArray | VertexList | WeightedAdjacencyMatrix | EdgeWeight | StringJoin (<>) | Riffle | First | Rest | Extract | Transpose | RandomFunction | VertexDelete | Condition (/;) | Greater (>) | VertexDegree | WeaklyConnectedComponents | Column | Background | LightYellow | LightGray | SortBy | VertexIndex | Take

Оригинальный пост: Centennial of Markov Chains
Перевод сделала Ольга Лавренюк, аспирантка СПбГУЭФ (ФИНЭК)
Адаптацию кода под русский текст произведения сделал Роман Осипов, администратор Русскоязычной поддержки Wolfram Mathematica, сертифицированный инструктор технологий и учебных курсов Wolfram Research

23 января 1913 года по Юлианскому календарю Андрей Андреевич Марков представил Петербургской Академии наук свой анализ произведения Пушкина «Евгений Онегин». Он обнаружил, что последовательность согласных и гласных букв в тексте может быть описана как случайная последовательность, где вероятный тип буквы зависит только от типа предыдущей или предыдущих двух букв.

В те времена Российская Империя использовала Юлианский календарь. Сотая годовщина знаменитого представления на самом деле была 5 февраля 2013 года, по текущему Григорианскому календарю.

закрыть

WolframAlpha["(Julian calendar January 23, 1913) plus 100 years", \{{"CorrespondingGregorianDate", 1}, "ComputableData"}]

Чтобы выполнить свой анализ, Марков изобрел то, что сейчас известно как “Марковские цепи”, которые могут быть представлены в виде вероятностной диаграммы состояний, где переходы между состояниями обозначаются вероятностями их осуществления.

Алиса в стране чудес: Изучение проблемы

В данной работе мы повторим исследования, которые Марков проводил с текстом Пушкина, с  текстом “Приключений Алисы в стране чудес” Льюиса Кэролла. Для этого давайте определим функцию подсчета частоты элементов списка, возвращающих результат в виде списка правил.

закрыть

Frequencies[data_] := Block[{ta = Tally[data]}, ta[[All, 2]] /= Length[data]; Rule @@@ ta]

Во-первых, извлечем слова из текста, записав их с маленькой буквы.

Оригинал (английский язык)

закрыть

Short[AiWwords[eng] = ToLowerCase[ StringSplit[ExampleData[{"Text", "AliceInWonderland"}], RegularExpression["[\\W_]+"]]]]

Перевод (русский язык)

закрыть

Short[AiWwords[rus] = DeleteCases[ StringSplit[ StringReplace[ Import[FileNameJoin[{NotebookDirectory[], "Alisa_v_strane_chudes.txt"}], CharacterEncoding -> "WindowsCyrillic"], Thread[CharacterRange["А", "Я"] -> CharacterRange["а", "я"]]], RegularExpression["[\\W_]+"] | "\[Ellipsis]" | "\[LongDash]"], ""]]

Разделим текст на последовательность букв:

закрыть

Short[AiWletters[eng] = Flatten[Characters[AiWwords[eng]]]]

закрыть

Short[AiWletters[rus] = Flatten[Characters[AiWwords[rus]]]]

Определим их категорию — гласные или согласные:

Оригинал (английский язык)

закрыть

VowelOrConsonantEng[l_String] := If[StringMatchQ[l, "a" | "e" | "u" | "i" | "o" | ""], "гласная", "согласная"]

Перевод (русский язык)

закрыть

VowelOrConsonantRus[l_String] := If[StringMatchQ[l, "а" | "у" | "о" | "ы" | "и" | "э" | "я" | "ю" | " Q" | "е"], "гласная", "согласная"]

закрыть

(vcseq[eng] = VowelOrConsonantEng /@ AiWletters[eng]) // Short

закрыть

(vcseq[rus] = VowelOrConsonantRus /@ AiWletters[rus]) // Short

И вычислим частоту встречи гласных и согласных букв в тексте:

закрыть

vcfreq1[eng] = Frequencies[vcseq[eng]] // N

закрыть

vcfreq1[rus] = Frequencies[vcseq[rus]] // N

Тем самым, если мы рассмотрим текст, как случайную последовательность гласных или согласных, то вероятность появления гласных будет p=0.3866 (английский) и p=0.42965 (русский).

Как и Марков, давайте рассмотрим частоту появления идущих подряд символов определенного типа:

закрыть

vcfreq2[eng] = Frequencies[Partition[vcseq[eng], 2, 1]] // N

закрыть

vcfreq2[rus] = Frequencies[Partition[vcseq[rus], 2, 1]] // N

Затем найдем вероятность того, какого типа будет буква, следующая за данной, гласной или согласной:

закрыть

condprobs[eng] = Join[ Frequencies[Cases[Partition[vcseq[eng], 2, 1], {"гласная", _}]], Frequencies[ Cases[Partition[vcseq[eng], 2, 1], {"согласная", _}]]] // N

закрыть

condprobs[rus] = Join[ Frequencies[Cases[Partition[vcseq[rus], 2, 1], {"гласная", _}]], Frequencies[ Cases[Partition[vcseq[rus], 2, 1], {"согласная", _}]]] // N

В своей работе Марков заметил, что последовательность гласных и согласных лучше описывается моделью, где вероятность гласной зависит от предшествующей буквы, чем моделью, где не зависит. Более того, он заметил, что модель, где вероятность зависит от двух предшествующих букв, подходит еще лучше

С помощью Mathematica мы можем продолжить это исследование. Марков обнаружил, что пара идущих подряд гласной-согласной несет больше информации, чем последовательность гласная-согласная сама по себе. Одним из способов измерения объема информации, заключенной в данных, служит вычисление информационной энтропии, для чего в Mathematica служит встроенная функция Entropy. Чем выше энтропия, тем больше содержится информации. Давайте вычислим ее для последовательностей из k разных сочетаний гласных-согласных (известных как k-граммы) для различных значений k.

закрыть

ListPlot[{Table[{k, Entropy[Partition[vcseq[eng], k, 1]] // N}, {k, 1, 30}], Table[{k, Entropy[Partition[vcseq[rus], k, 1]] // N}, {k, 1, 30}]}, ImageSize -> 490, PlotMarkers -> {Automatic, Medium}, AxesLabel -> (Style[#, 16, Bold] & /@ {"k", "Энтропия"}), PlotLegends -> {"Английский", "Русский"}]

График подтверждает результаты Маркова. Любопытно, что он также показывает, что 20-граммы несут совсем немного больше информации, чем 30-граммы (для английского языка, для перевода на русский картина аналогична).

Вероятностная модель на основе 2-граммов, описывающая последовательность сейчас известна как Марковский процесс.

Марковский процесс описывает процесс изменения распределения вероятности   в пространстве состояний на шаге n. Предполагая, что пространство состояний конечно (в данном примере оно состоит из 2-ух элементов {“гласная”, ”согласная”}), распределение вероятностей можно рассматривать как вектор, и условные вероятности перехода могут быть представлены в виде матрицы P:

В данном случае матрица перехода выглядит так:

закрыть

MatrixForm[ tm[eng] = Outer[List, {"гласная", "согласная"}, {"гласная", "согласная"}] /. condprobs[eng]]

закрыть

MatrixForm[ tm[rus] = Outer[List, {"гласная", "согласная"}, {"гласная", "согласная"}] /. condprobs[rus]]

Если предположить, что начальное состояние является гласной буквой (обозначим как 1 в коде), модель на основе 2-граммов определяется в Mathematica следующим образом:

закрыть

mproc[eng] = DiscreteMarkovProcess[1, tm[eng]]

закрыть

mproc[rus] = DiscreteMarkovProcess[1, tm[rus]]

Теперь мы можем узнать распределение расстояний между двумя гласными в тексте и сравнить результат с данными:

Оригинал (английский язык)

закрыть

Mean[FirstPassageTimeDistribution[mproc[eng], 1]]

закрыть

Mean[Differences[ Pick[Range[Length[vcseq[eng]]], vcseq[eng], "гласная"]]] // N

Перевод (русский язык)

закрыть

Mean[FirstPassageTimeDistribution[mproc[rus], 1]]

закрыть

Mean[Differences[ Pick[Range[Length[vcseq[rus]]], vcseq[rus], "гласная"]]] // N

Таким образом, модель Маркова точно предсказывает, что среднее расстояние между гласными в тексте равно примерно 2,586 буквы (2.327 буквы для русского языка, причем для русского языка предсказание отличается от вычисленного по данным значениям лишь в 5-м знаке!). Распределение расстояний, предсказываемое моделью, также хорошо подтверждается аналогичными расстояниями, вычисленными по тексту:

Оригинал (английский язык)

закрыть

DiscretePlot[ PDF[FirstPassageTimeDistribution[mproc[eng], 1], n], {n, 1, 10}, ExtentSize -> {0, 2/3}, PlotStyle -> Black, ImageSize -> 600]

закрыть

Show[{Histogram[ Differences[ Pick[Range[Length[vcseq[eng]]], vcseq[eng], "гласная"]], {1}, "Probability", ChartStyle -> "Rainbow"], %}, ImageSize -> 600]

Перевод (русский язык)

закрыть

DiscretePlot[ PDF[FirstPassageTimeDistribution[mproc[rus], 1], n], {n, 1, 10}, ExtentSize -> {0, 2/3}, PlotStyle -> Black, ImageSize -> 600]

закрыть

Show[{Histogram[ Differences[ Pick[Range[Length[vcseq[rus]]], vcseq[rus], "гласная"]], {1}, "Probability", ChartStyle -> "Rainbow"], %}, ImageSize -> 600]

Генерация текста

В тексте “Алисы в стране Чудес” используется всего 1484 уникальных слова на языке оригинала (и 5734 в переводе на русский):

закрыть

DeleteDuplicates[AiWwords[eng]] // Length

закрыть

DeleteDuplicates[AiWwords[rus]] // Length

Повторив тот же анализ со словами, а не гласными-согласными буквами, мы сможем обнаружить, что 4-граммы содержат всю основную информацию (для обоих языков):

закрыть

ListPlot[{Table[{k, Entropy[Partition[AiWwords[eng], k, 1]] // N}, {k, 1, 7}], Table[{k, Entropy[Partition[AiWwords[rus], k, 1]] // N}, {k, 1, 7}]}, ImageSize -> 490, PlotMarkers -> {Automatic, Medium}, AxesLabel -> (Style[#, 16, Bold] & /@ {"k", "Энтропия"}), PlotLegends -> {"Английский", "Русский"}, PlotRange -> All]

С моделью на основе 4-gграммов, частота описывает вероятность появления , учитывая три последних слова .

закрыть

(gram4data[eng] = Flatten[Frequencies /@ GatherBy[Partition[AiWwords[eng], 4, 1], Most]] // N) // Short[#, 3] &

закрыть

(gram4data[rus] = Flatten[Frequencies /@ GatherBy[Partition[AiWwords[rus], 4, 1], Most]] // N) // Short[#, 3] &

Рассмотрим переходы в виде направленного графа,  связывая каждое ребро с помощью свойства “Probability” (вероятность), которое определяет условную вероятность перехода.

Оригинал (английский язык)

закрыть

gram4gr[eng] = Graph[gram4data[ eng] /. {HoldPattern[{w1_, w2_, w3_, w4_} -> p_] :> Property[{w1, w2, w3} \[DirectedEdge] {w2, w3, w4}, "Probability" -> p]}, ImageSize -> 600]

Перевод (русский язык)

закрыть

gram4gr[rus] = Graph[gram4data[ rus] /. {HoldPattern[{w1_, w2_, w3_, w4_} -> p_] :> Property[{w1, w2, w3} \[DirectedEdge] {w2, w3, w4}, "Probability" -> p]}, ImageSize -> 600]

Полагая, что начальный вектор вероятности задается частотами последовательных пар слов, мы можем задать дискретный марковский процесс.

Оригинал (английский язык)

закрыть

initialProbabilityVector[eng] = SparseArray[ VertexList[gram4gr[eng]] /. Frequencies[Partition[AiWwords[eng], 3, 1]]];

закрыть

transitionMat[eng] = WeightedAdjacencyMatrix[gram4gr[eng], EdgeWeight -> "Probability"]

закрыть

mc[eng] = DiscreteMarkovProcess[initialProbabilityVector[eng] // N, transitionMat[eng]]

Перевод (русский язык)

закрыть

initialProbabilityVector[rus] = SparseArray[ VertexList[gram4gr[rus]] /. Frequencies[Partition[AiWwords[rus], 3, 1]]];

закрыть

transitionMat[rus] = WeightedAdjacencyMatrix[gram4gr[rus], EdgeWeight -> "Probability"]

закрыть

mc[rus] = DiscreteMarkovProcess[initialProbabilityVector[rus] // N, transitionMat[rus]]

Теперь зададим  функцию, соединяющую последовательность k-граммов, получаемую в результате обхода графа в текст.

закрыть

GramListToText[list_] := StringJoin[Riffle[Join[First[list], Rest[list][[All, -1]]], " "]]

We can now simulate the resulting Markov chain to generate a random 100-words text:

закрыть

GramListToText[ Extract[VertexList[gram4gr[eng]], Transpose[RandomFunction[mc[eng], {0, 100}]["States"]]]]

закрыть

GramListToText[ Extract[VertexList[gram4gr[rus]], Transpose[RandomFunction[mc[rus], {0, 100}]["States"]]]]

Лингвистический анализ

Граф, полученный на основе 4-граммов, имеет заметные длинные линейные подграфы, которые представляют собой длинные нити из вершин. Слова, появляющиеся в этих цепочках, будут всегда появляться вместе в случайно сгенерированном текст. Интересно установить длины такого рода неизменных последовательностей.

Эти длинные подграфы могут быть выделены путем удаления из исходного графа всех вершин, которые имеют больше двух ребер.

Оригинал (английский язык)

закрыть

lines[eng] = VertexDelete[gram4gr[eng], VertexList[gram4gr[eng], x_ /; VertexDegree[gram4gr[eng], x] > 2]]

Перевод (русский язык)

закрыть

lines[rus] = VertexDelete[gram4gr[rus], VertexList[gram4gr[rus], x_ /; VertexDegree[gram4gr[rus], x] > 2]]

Воспользуемся функцией WeaklyConnectedComponents для извлечения вершин этих строк. После сортировки их в том порядке, в котором они появлялись в тексте, мы воссоздадим 6 самых длинных последовательностей. Каждый отрывок из текста, за исключением пунктуации, в котором каждые последовательности из четырех слов встречаются в тексте однократно:

Оригинал (английский язык)

закрыть

lineData[eng] = WeaklyConnectedComponents[lines[eng]];

закрыть

GramListToText[SortBy[#, VertexIndex[lines[eng], #] &]] & /@ Take[lineData[eng], 6] // Column[#, Background -> {{LightYellow, LightGray}}] &

Перевод (русский язык)

закрыть

lineData[rus] = WeaklyConnectedComponents[lines[rus]];

закрыть

GramListToText[SortBy[#, VertexIndex[lines[rus], #] &]] & /@ Take[lineData[rus], 6] // Column[#, Background -> {{LightYellow, LightGray}}] &

Как можно заметить, 6 последовательностей действительно весьма длинные. На самом деле, они крайне длинные. Средняя длина таких фрагментов 8 слов. Можно было бы продолжать этот анализ на другие произведения литературы и сравнить результаты, но мы оставим это на другой раз.

Конечные Марковские процессы в Mathematica могут быть использованы для решения широкого круга прикладных и теоретических задач. Есть много примеров использования в Wolfram Demonstrations Project, которые помогут вам отметить 100-летний юбилей существования понятия “Цепь Маркова”.

Блог принадлежит “Русскоязычной поддержке Wolfram Mathematica"©
При любом использовании материалов блога, ссылка на блог обязательна.
Создано с помощью Wolfram Mathematica 9