【机器学习(八)】概率图模型

概率图模型:
用图的表示法来描述一系列随机变量之间的条件独立性关系的模型。
内容:

  • 朴素贝叶斯分类器
  • 隐马尔科夫模型(HMM)

1. 图论入门

图(graph)
节点(node)集合:包含顶点
边(edge)集合:包含顶点之间的边
一个图就是一些点及其之间的连接进行的描述
有向图(directed graph)
源点(source) 到目标点(target)
尾顶点(tail vertex)到头顶点(head vertex)
无向图(undirected graph)

邻接矩阵(adjacency matrix)
如果有𝑉个顶点,邻接矩阵就是𝑉 × 𝑉的矩阵;如果有连通就是1,没有连通就是0
由于矩阵不对称,我们知道是有向图
路径(path):如果从顶点𝑣𝑖开始,沿着边在图中移动,穿过任意数量的顶点,最后抵达𝑣𝑗。那么中间经过的边构成了路径


回路(cycle)
一条起始并终止在同一个顶点的路径
无环图(acyclic graph)
没有任何回路的图
有向无环图(directed acyclic graph)=DAG
没有任何回路的图里存在有向边
• Facebook:朋友关系是相互的,无向图
• Twitter:关注关系就不是相互的,有向图
• 网页到网页的跳转
• 运输网络、通讯网络、电网等

概率图模型(probabilistic graphical model)或者简称图模型(graphical model)
节点代表随机变量
边代表依赖关系


2. 贝叶斯定理

  • 两个事件A和B

    事件A:病人患有阑尾炎,事件B:病人的白细胞计数高,已知事件B的情况下,事件A的条件概率:
  • 贝叶斯定理


    概念:
    Pr (𝐴) :先验概率(prior probability)
    Pr(𝐴|𝐵):后验概率(posterior probability)
    例子:
    病人通常患有阑尾炎,白细胞计数偏高
    已知事件B,白细胞计数(容易观测)偏高的请况下,病人患有阑尾炎(不容易观测)的概率会改变
    已知患有阑尾炎其白细胞计数增高的概率Pr(𝐵|𝐴)很好计算


3. 条件独立

统计性独立
两个随机变量A和B联合概率就是它们的(边缘)概率的乘积
Pr(𝐴 ∩ 𝐵) = Pr(𝐴) ∙ Pr (𝐵)
有时候两个变量不一定是统计性独立的,但对第三个变量C进行观察,可能会发现它们之间变成了独立的
Pr(𝐴 ∩ 𝐵|𝐶) = Pr(𝐴|𝐵) ∙ Pr (𝐵|𝐶)


4. 贝叶斯网络

  • 贝叶斯网络(Bayesian network)
    一种涉及有向无环图的图模型
    双亲(parent):有向边的尾节点
    孩子(child)或后代(descendant):头节点
    节点A到节点B有一条路径,节点B就是节点A的一个后代或孩子
    直系后代(direct descendant):节点A直接连节点B

  • 局部马尔科夫性
    给定双亲,每个节点就条件独立于网络中不是它后代的所有其他节点
    我们只需要关心边就行
    局部马尔科夫性可以帮助我们对模型中所有随机变量的联合概率函数进行因式分解
    三个变量的概率乘法法则(G,J,U)
    Pr(𝐺,𝐽,𝑈) = Pr(𝐺|𝐽,𝑈) ∙ Pr (𝐽|𝑈) ∙ Pr(𝑈)
    利用贝叶斯网络的局部马尔科夫性
    Pr(𝐺,𝐽,𝑈) = Pr(𝐺|𝐽) ∙ Pr(𝐽|𝑈) ∙ Pr(𝑈)
    节约计算量、存储量
    独立关系可以分解,任务也可以大大简化


5. 朴素贝叶斯分类器

一种有向无环图,一个双亲节点和一系列代表随机变量的孩子节点,孩子节点只依赖双亲节点,之间没有依赖关系

给定了Sentiment节点,所有其他节点都是相互独立的

𝐶是双亲节点,𝐹𝑖则是孩子节点或者特征节点

利用网络的条件独立性假设来简化

要做一个分类器:
目标是选出类别𝐶𝑖,他们能够最大化后验概率Pr(𝐶𝑖|𝐹1, … , 𝐹𝑛)

Classify 𝐶𝑖:
预测电影评论里的情绪

在论坛、在线评论和社交媒体的世界里面,有一种任务,情感分析(sentiment analysis)。

  • 对一段文字进行分析,确定作者要表达的情感
  • 收集在线评论、博客文字或者推特上的推文
  • 构建一个模型来预测用户的感受是正面还是负面
  • 或者更细微的情绪,轻微负面和非常负面等

《Learning word vectors for sentiment analysis》
25000条影评的训练集和另外25000条的测试集

tm包(text mining)

学会读懂corpus的格式:
动态语料库(Volatile Corpus,作为R对象保存在内存中)和静态语料库(Permanent Corpus,R 外部保存)。
所对应的函数分别是 VCorpus() 和 PCorpus()

VCorpus(x, readerControl = list(reader = reader(x),
language = "en"))

x:
DirSource:处理目录
VectorSource:由文档构成的向量
DataframeSource:数据框,就像CSV 文件

  • 每个文件采用<counter>_<score>.txt的格式来取名的,这个信息会放到Vcorpus()函数创建的语料库对象的meta部分,可以用meta调看
  • 评分(score)部分是一个介于0到10的数字,较大代表正面评分,较小代表负面评分,评分范围0-4,7-10
  • 利用正则表达规则,及函数sub()从文档名列表中取出评分部分

描述在辞典里面的特定单词是否出现二元特征

  • 负面boring,cliché和horrible(无聊、陈词滥调和可怕)
  • 正面inspiring,enjoyable,moving和excellent(鼓舞人心、愉快的、感人的和优秀的)

预处理 tm_map() 和content_transformer()
单词转换成小写格式(Excellent=excellent)
删除标点符号、数字、停用词(stop words)
停用词:the, and, in和be
标记化(tokenization):文本拆分成单词

文档-词条矩阵(document term matrix)
行是文档,列是辞典里的单词
矩阵里面每个元素是一个二元值,1对应的事实是:列号代表的单词会在行号代表的影评中出现。例如,第一列对应的单词action,第四行对应代表第四个影评,在该矩阵(4,1)这个位置的元素是1,代表第四个影评中包含了单词action

tm提供了DocumentTermMatrix()这个函数
一共251136列,代表语料库里面找到的不同单词的数量,这个矩阵是非常稀疏的
从稀疏和非稀疏的比例来看,25000条观测数据去学习251136个特征的问题也很难。需要去除稀疏性removeSpareTerms,这样特征数降低到1710个,观测数据量依然是25000,最大允许稀疏度99%,实现稀疏程度是95%。

波特词干提取器(Porter Stemmer)
像movie和movies这样的单词是作为不同的单词进行处理的,即使它们是同一个词,只是词尾有点变化而已。
词形变化(inflection)是一种改变单词的基本形式或词目(lemma)使之与另一个单词在时态、格、性别、单复数等属性上呼应的过程。
tm包支持词干提取(stemming),去除单词的词形变化的过程,只保留词干。

library(NLP)
library(tm)

#设置文件路径
path_to_neg_folder<-"aclImdb/train/neg"
path_to_pos_folder<-"aclImdb/train/pos"

#读取文件DirSource()路径函数
nb_pos <- VCorpus(DirSource(path_to_pos_folder), readerControl = list(reader = reader(DirSource(path_to_pos_folder)), language = "en"))
nb_neg <- VCorpus(DirSource(path_to_neg_folder), readerControl = list(reader = reader(DirSource(path_to_neg_folder)), language = "en"))
#合并两个数据
nb_all <- c(nb_pos,nb_neg)

#观察数据
View(nb_all[[2]])
meta(nb_all[[20000]])

#获得所有文件名,后面根据文件名解析出评分
ids<-sapply(1:length(nb_all),function(x) meta(nb_all[[x]],"id"))
head(ids)

#解析评分,大于等于5的分为postive,小于5分的为negative
scores<-as.numeric(sapply(ids,function(x) sub("[0-9]+_([0-9]+)\\.txt","\\1",x)))
scores<-factor(ifelse(scores>=5,"positive","negative"))
summary(scores)

#文本处理
nb_all <- tm_map(nb_all, content_transformer(removeNumbers)) #移除数字
nb_all <- tm_map(nb_all, content_transformer(removePunctuation)) #移除标点符号
nb_all <- tm_map(nb_all, content_transformer(tolower)) #转换为小写
nb_all <- tm_map(nb_all, content_transformer(removeWords), stopwords("english"))
nb_all <- tm_map(nb_all, content_transformer(stripWhitespace)) #去除空格

#将数据转换为矩阵
nb_dtm <-DocumentTermMatrix(nb_all)
dim(nb_dtm)

#压缩矩阵,去掉为空的项
nb_dtm<-removeSparseTerms(x=nb_dtm, sparse = 0.99)
dim(nb_dtm)

nb_dtm <- weightBin(nb_dtm) ## 所有元素变换成二元因子
inspect(nb_dtm[1000:1006,100:106]) #查看数据框
nb_df <- as.data.frame(as.matrix(nb_dtm)) #将矩阵变为dataframe

#划分训练集和测试集
library(caret)
set.seed(443452342)
nb_sampling_vector <- createDataPartition(scores, p = 0.80, list = FALSE)
nb_df_train <- nb_df[nb_sampling_vector,]
nb_df_test <- nb_df[-nb_sampling_vector,]
scores_train = scores[nb_sampling_vector]
scores_test = scores[-nb_sampling_vector]

#用naiveBayes函数进行学习
library("e1071")
nb_model <- naiveBayes(nb_df_train, scores_train)

nb_train_predictions <- predict(nb_model, nb_df_train)
mean(nb_train_predictions == scores_train)
table(actual = scores_train, predictions = nb_train_predictions)

nb_test_predictions <- predict(nb_model, nb_df_test)
mean(nb_test_predictions == scores_test)
table(actual = scores_test, predictions = nb_test_predictions)
#输出结果,可以达到81%的准确率

#修正方法一后的代码
library(SnowballC)
nb_all <- tm_map(nb_all, stemDocument, language = "english")
nb_dtm <- DocumentTermMatrix(nb_all) 
nb_dtm <- removeSparseTerms(x=nb_dtm, sparse = 0.99)
nb_dtm <- weightBin(nb_dtm)
nb_df <- as.data.frame(as.matrix(nb_dtm))
nb_df_train <- nb_df[nb_sampling_vector,]
nb_df_test <- nb_df[-nb_sampling_vector,]

nb_model_stem <- naiveBayes(nb_df_train, scores_train)
nb_test_predictions_stem <- predict(nb_model_stem, nb_df_test)
mean(nb_test_predictions_stem == scores_test)
table(actual = scores_test, predictions = nb_test_predictions_stem)

# Note: Recompute the nb_dtm without stemming before running the next bit
nb_model_laplace <- naiveBayes(nb_df_train, scores_train, laplace=10)
nb_test_predictions_laplace <- predict(nb_model_laplace, nb_df_test)
mean(nb_test_predictions_laplace == scores_test)
table(actual = scores_test, predictions = nb_test_predictions_laplace)
  • 修正方法一后的代码
  • 修正方法二后的代码
    正则化技术:训练朴素贝叶斯模型中运用添加平滑(additive smoothing)技术,也叫做拉普拉斯平滑(lapacian smoothing)技术
    解决矩阵稀疏:给一些没有出现过的词一些极小的概率。
    假设在文本分类中,有3个类,C1、C2、C3,在指定的训练样本中,某个词语K1,在各个类中观测计数分别为0,990,10,K1的概率为0,0.99,0.01,对这三个量使用拉普拉斯平滑的计算方法如下: 1/1003 = 0.001,991/1003=0.988,
    11/1003=0.011
  • 修正方法三
    用PCA减少特征量
  • 修正方法四
    假定某个影评里所有的单词都是相互独立的,这不符合实际,例如not bad,其实并不是表示bad。否定是文本处理中的最困难的问题之一。还有挖苦、讽刺、包含其他人想法的句子等。

6.隐马尔科夫模型

隐马尔可夫模型(Hidden Markov model):
对序列进行预测和建模的带有重复性结构的贝叶斯模型
应用1:对DNA基因序列进行建模
应用2:对组成英语文字的字母序列进行建模


一个序列从左向右移动,标签𝑧𝑖的节点为隐含状态(latent state)、隐藏状态(hidden state)或直接称之为状态(state)。
标签𝑥𝑖节点是可观测状态(observed state)或观测数据(observation)。
这是一个贝叶斯网络,知道对应的状态后,所有观测数据都是相互独立的;同样知道某个节点前面的一个状态,每个状态都独立于序列中在它之前的其他每个状态。

NLP中,对词性标注的应用
词性标注器的任务是读取一个句子并返回对应该句子中单词的词性标签。例如:The返回determiner(限定词),对单词task返回singular noun(单数),诸如此类。
单词作为观测数据,词性标注作为隐含状态。
前者可以观测,后者想要判定。
例如,命名实体识别,目标是在一个句子中识别出指代个人、地点、组织和其他实体的名词的单词。

5个部分,后面3个部分涉及概率
起始概率向量(starting probability vector)
转移概率矩阵(transition probability matrix):状态𝑧𝑖到状态𝑧𝑖+1的概率矩阵
发出概率矩阵(emission probability matrix)遇到每种状态,在辞典里每个符号的发出概率
例如某些单词(例如bank可以是名词也可以是动词)会被标记上
多个词性标记

预测启动子基因序列

DNA分子的基本组成是4种被称为核苷酸(nucleotide)的基本分子。胸腺嘧啶、胞嘧啶、腺嘌呤、鸟嘌呤(Thymine, Cytosine, Adenine, Guanine)四种分子在DNA链中的顺序编码了DNA所携带的遗传信息。

目标:在DNA链条中找到启动子序列。这些序列是核苷酸的特殊序列,它们在调节一种被称为基因转录(gene transcription)的遗传过程中扮演了重要角色。是DNA中信息被读取的机制第一步。

用HMM构建识别非启动子基因序列和启动子基因序列的模型,构建一个针对启动子的HMM和一个针对非启动子的HMM,挑出能对一个测试序列产生最高概率的模型来标记该序列。

####例子1:预测启动子基因序列
promoters <- read.csv("promoters.data", header=F, dec=",", strip.white=TRUE, stringsAsFactors = FALSE)
#V1:+表示启动子,-表示非启动子
#V2:特定序列的识别符
#V3:核苷酸序列本身(即观测序列,同时也是隐藏序列)
promoters[1,]

#数据拆分成启动子和非启动子。
#subset表示根据条件来筛选子集。这里的3表示选择第3列,丢弃掉1,2列
positive_observations <- subset(promoters, V1=='+', 3)
negative_observations <- subset(promoters, V1=='-', 3)

#在每个序列之前加上S,表示数据的开始,在每个结尾加上X,表示数据的结束
positive_observations<-sapply(positive_observations, function(x) paste("S",x,"X",sep=""))
negative_observations<-sapply(negative_observations, function(x) paste("S",x,"X",sep=""))
positive_observations[1]

#将一串字符串,按每个字母分开,得到一个列表
positive_observations<-strsplit(positive_observations,"")
negative_observations<-strsplit(negative_observations,"")
head(positive_observations[1])

#定义隐藏状态。我们的隐藏状态有以下6个(S,X,a,c,g,t)
states <- c("S", "X", "a", "c", "g", "t")
#定义观测状态。我们的观测状态也有6个
symbols <- c("S", "X", "a", "c", "g", "t")
#定义初始概率,也即pi,表示刚开始的时候,只有S,即从S开始。
startingProbabilities<-c(1,0,0,0,0,0)
#定义发射概率,也即观测状态转移概率矩阵 B。这里是一个对角矩阵,对角线都为1,其余为0
#代表只能从S到S,从a到a,从c到c,从g到g,从t到t
emissionProbabilities<-diag(6)
colnames(emissionProbabilities)<-states #列名为状态值
rownames(emissionProbabilities)<-symbols #行名为观测值
emissionProbabilities

#根据我们的样本,来计算转移概率矩阵。
calculateTransitionProbabilities <- function(data, states) {
 #初始化转移状态矩阵,刚开始都为0
    transitionProbabilities<-matrix(0,length(states),length(states))
    colnames(transitionProbabilities)<-states
    rownames(transitionProbabilities)<-states
#按顺序循环数据中的每一个字母,统计从状态A状态B的次数,并放到矩阵中。即汇总出每一个状态转移的总数
    for (index in 1:(length(data)-1)) {
        current_state <- data[index]
        next_state <- data[index+1]
        transitionProbabilities[current_state, next_state] <- transitionProbabilities[current_state, next_state] + 1
    }
    #根据次数矩阵,使用sweep函数来计算概率。
    #swepp中的第二个参数1,代表按行计算;2,代表按列计算
    #rowSums函数代表按行进行求和
    #整个函数的意思就是,用每一行的元素除以这一行的数据总和,得到归一化的概率;
    transitionProbabilities<-sweep(transitionProbabilities, 1, rowSums(transitionProbabilities), FUN="/")
    return(transitionProbabilities)
}

#这里相当于把negative_observations从原来的列表转换为了一个向量
#即,把原来每一行数据,都进行了连接,形成了一个长向量,向量长度为原来的行数*每行的字母个数
negative_observation<-Reduce(function(x,y) c(x, y), negative_observations, c())
#使用非启动子基因序列的样本来训练转移概率矩阵。
(transitionProbabilitiesNeg  <- calculateTransitionProbabilities(negative_observation, states))

#使用HMM的五个参数来初始化隐马尔可夫模型
library("HMM")
negative_hmm = initHMM(states, symbols, startProbs=startingProbabilities, transProbs=transitionProbabilitiesNeg, emissionProbs=emissionProbabilities)

#交叉检验。每次我们从启动子基因序列的样本中拿出一条数据作为检验数据,剩下的作为训练集数据
#先用剩下的数据来构建HMM模型,此时的模型是根据启动子基因序列来构建的
#然后,我们用剩下的这条检验数据,分别带入到之前negative_hmm模型和现在的positive_hmm模型中,采用向前算法来计算出现该基因序列的概率
#理论上,因为这条检验数据是来自于启动子基因序列,因此,通过negative_hmm模型计算出来的概率应该小于使用positive_hmm模型计算出来的概率。
#统计错误率,我们即可知道模型的好坏
incorrect<-0 #定义错误次数统计变量
for (obs in 1:length(positive_observations)) {
#使用启动子基因序列,构造启动子基因序列模型,方便后面进行对比  
positive_observation<-Reduce(function(x,y) c(x, y), positive_observations[-obs], c())
transitionProbabilitiesPos  <- calculateTransitionProbabilities(positive_observation, states)
positive_hmm = initHMM(states, symbols, startProbs=startingProbabilities, transProbs=transitionProbabilitiesPos, emissionProbs=emissionProbabilities)

  #获取检验数据
test_observation<-positive_observations[[obs]]
final_index<-length(test_observation)

#将检验数据分别带入到两个模型中,使用向前算法,分别计算使用这两个模型得到该序列的概率
pos_probs<-exp(forward(positive_hmm,test_observation))
neg_probs<-exp(forward(negative_hmm,test_observation))

#计算出现该序列的概率之和。(上面得到的是序列中每个碱基出现的概率)
pos_seq_prob<-sum(pos_probs[,final_index])
neg_seq_prob<-sum(neg_probs[,final_index])

#如果使用positive模型得到的概率小于使用negative模型得到概率,则错误数+1
if (pos_seq_prob<neg_seq_prob) incorrect<-incorrect+1

}

#反过来,使用positive数据构建模型,使negative数据进行检验。因此以下代码不再做解释
positive_observation <- Reduce(function(x,y) c(x, y), positive_observations, c())
transitionProbabilitiesPos  <- calculateTransitionProbabilities(positive_observation, states)
positive_hmm = initHMM(states, symbols, startProbs=startingProbabilities, transProbs=transitionProbabilitiesPos, emissionProbs=emissionProbabilities)

for (obs in 1:length(negative_observations)) {

negative_observation<-Reduce(function(x,y) c(x, y), negative_observations[-obs], c())
transitionProbabilitiesNeg <- calculateTransitionProbabilities(negative_observation, states)
negative_hmm = initHMM(states, symbols, startProbs=startingProbabilities, transProbs=transitionProbabilitiesNeg, emissionProbs=emissionProbabilities)

test_observation<-negative_observations[[obs]]
final_index<-length(test_observation)

pos_probs<-exp(forward(positive_hmm,test_observation))
neg_probs<-exp(forward(negative_hmm,test_observation))

pos_seq_prob<-sum(pos_probs[,final_index])
neg_seq_prob<-sum(neg_probs[,final_index])

if (pos_seq_prob>neg_seq_prob) incorrect<-incorrect+1

}

#最后计算交叉检验后的准确度
(cross_validation_accuracy <- 1 - (incorrect/nrow(promoters)))

例子2: 分析英语单词的字母顺序模式(寻找隐藏序列的patten)

每个英语单词,其字母的组成顺序都是有一定规律的。我们很少看到在一个单词中,有两个元音字母连在一起。我们是否可以找到一个模型,来体现出来这种规律呢?
我们还是使用我们在上一讲中用到的文本数据。

#分析英语单词的字母顺序模式(寻找隐藏序列的patten)
library(ggplot2)
library("tm")
#读取文件
nb_pos <- VCorpus(DirSource(path_to_pos_folder), readerControl = list(reader = reader(DirSource(path_to_pos_folder)), language = "en"))
nb_neg <- VCorpus(DirSource(path_to_neg_folder), readerControl = list(reader = reader(DirSource(path_to_neg_folder)), language = "en"))
nb_all <- c(nb_pos,nb_neg) #合并两个数据
nb_all <- tm_map(nb_all, content_transformer(tolower)) #全部转换为小写

#因为nb_all的格式不好处理,我们将nb_all中的文本信息提取出来,存入到texts变量中
texts <- sapply(1 : length(nb_all), function(x) nb_all[[x]])

#文本处理
texts<-sapply(texts, function(x) gsub("\\s","W", x)) #把空格用W代替
texts<-sapply(texts, function(x) gsub("[0-9]","N", x)) #把数字用N代替
texts<-sapply(texts, function(x) gsub("[[:punct:]]","P", x)) #把标点符号用P代替
texts<-sapply(texts, function(x) gsub("[^a-zWNP]","O", x)) #其他符号用O代替
texts
#因为texts比较大,我们只取前40条数据,并将其每个字母打散,存入到列表中
big_text_splits<-lapply(texts[1:40], function(x) strsplit(x, ""))
big_text_splits<-unlist(big_text_splits, use.names = F) #将列表转换为向量

#由于我们不知道单词构造到隐藏状态,因此这里强行安了3个状态
states <- c("s1", "s2", "s3")
numstates <- length(states)
symbols <- c(letters,"W","N","P","O") #观测变量就是26个英文字母加上我们前面定义的几个特殊字母
numsymbols <- length(symbols)

#初始化一个初始状态概率矩阵pi。因为我们的隐藏状态也是随意给的,因此这里的初始状态概率矩阵也可以随机给一个
set.seed(124124)
startingProbabilities <- matrix(runif(numstates), 1, numstates)
startingProbabilities<-sweep(startingProbabilities, 1, rowSums(startingProbabilities), FUN="/")

#初始化一个转移状态矩阵
set.seed(454235)
transitionProbabilities<-matrix(runif(numstates*numstates),numstates,numstates)
transitionProbabilities<-sweep(transitionProbabilities, 1, rowSums(transitionProbabilities), FUN="/")

#初始化一个观测状态转移概率矩阵(发射矩阵)
set.seed(923501)
emissionProbabilities<-matrix(runif(numstates*numsymbols),numstates,numsymbols)
emissionProbabilities<-sweep(emissionProbabilities, 1, rowSums(emissionProbabilities), FUN="/")

#初始化隐马尔可夫模型
library("HMM")
hmm <- initHMM(states, symbols, startProbs = startingProbabilities, transProbs = transitionProbabilities, emissionProbs = emissionProbabilities)
#使用Baum-Welch 算法来学习参数。
hmm_trained <- baumWelch(hmm, big_text_splits)

hmm_trained$hmm

#根据学习后的参数,我们来画出转移概率矩阵。转移概率矩阵体现了在一个单词中,每个字母出现的概率
#画出从状态S1到各字母之间的概率
p1 <- ggplot(data=data.frame(hmm_trained$hmm$emissionProbs[1,]), aes(x = names(hmm_trained$hmm$emissionProbs[1,]), y = hmm_trained$hmm$emissionProbs[1,]))
p1 <- p1 + geom_bar(stat="identity")
p1 <- p1 + ggtitle("Symbol Emission Probabilities for State 1")
p1 <- p1 + theme(plot.title = element_text(lineheight=.8, face="bold", vjust=2))
p1 <- p1 + xlab("State")  
p1 <- p1 + ylab("Emission Probability") 
p1

#画出从状态S2到各字母之间的概率 
p2 <- ggplot(data=data.frame(hmm_trained$hmm$emissionProbs[2,]), aes(x = names(hmm_trained$hmm$emissionProbs[2,]), y = hmm_trained$hmm$emissionProbs[2,]))
p2 <- p2 + geom_bar(stat="identity")
p2 <- p2 + ggtitle("Symbol Emission Probabilities for State 2")
p2 <- p2 + theme(plot.title = element_text(lineheight=.8, face="bold", vjust=2))
p2 <- p2 + xlab("State")  
p2 <- p2 + ylab("Emission Probability") 
p2

#画出从状态S3到各字母之间的概率
p3 <- ggplot(data=data.frame(hmm_trained$hmm$emissionProbs[3,]), aes(x = names(hmm_trained$hmm$emissionProbs[3,]), y = hmm_trained$hmm$emissionProbs[3,]))
p3 <- p3 + geom_bar(stat="identity")
p3 <- p3 + ggtitle("Symbol Emission Probabilities for State 3")
p3 <- p3 + theme(plot.title = element_text(lineheight=.8, face="bold", vjust=2))
p3 <- p3 + xlab("State")  
p3 <- p3 + ylab("Emission Probability") 
p3

#获得隐含状态转移概率矩阵
(trained_transition_probabilities<-hmm_trained$hmm$transProbs)

#模拟给定隐马尔可夫模型的状态和观测路径。即根据模型构造一个句子(单词)
set.seed(9898)
simHMM(hmm_trained$hmm, 30)
©著作权归作者所有,转载或内容合作请联系作者
  • 序言:七十年代末,一起剥皮案震惊了整个滨河市,随后出现的几起案子,更是在滨河造成了极大的恐慌,老刑警刘岩,带你破解...
    沈念sama阅读 211,948评论 6 492
  • 序言:滨河连续发生了三起死亡事件,死亡现场离奇诡异,居然都是意外死亡,警方通过查阅死者的电脑和手机,发现死者居然都...
    沈念sama阅读 90,371评论 3 385
  • 文/潘晓璐 我一进店门,熙熙楼的掌柜王于贵愁眉苦脸地迎上来,“玉大人,你说我怎么就摊上这事。” “怎么了?”我有些...
    开封第一讲书人阅读 157,490评论 0 348
  • 文/不坏的土叔 我叫张陵,是天一观的道长。 经常有香客问我,道长,这世上最难降的妖魔是什么? 我笑而不...
    开封第一讲书人阅读 56,521评论 1 284
  • 正文 为了忘掉前任,我火速办了婚礼,结果婚礼上,老公的妹妹穿的比我还像新娘。我一直安慰自己,他们只是感情好,可当我...
    茶点故事阅读 65,627评论 6 386
  • 文/花漫 我一把揭开白布。 她就那样静静地躺着,像睡着了一般。 火红的嫁衣衬着肌肤如雪。 梳的纹丝不乱的头发上,一...
    开封第一讲书人阅读 49,842评论 1 290
  • 那天,我揣着相机与录音,去河边找鬼。 笑死,一个胖子当着我的面吹牛,可吹牛的内容都是我干的。 我是一名探鬼主播,决...
    沈念sama阅读 38,997评论 3 408
  • 文/苍兰香墨 我猛地睁开眼,长吁一口气:“原来是场噩梦啊……” “哼!你这毒妇竟也来了?” 一声冷哼从身侧响起,我...
    开封第一讲书人阅读 37,741评论 0 268
  • 序言:老挝万荣一对情侣失踪,失踪者是张志新(化名)和其女友刘颖,没想到半个月后,有当地人在树林里发现了一具尸体,经...
    沈念sama阅读 44,203评论 1 303
  • 正文 独居荒郊野岭守林人离奇死亡,尸身上长有42处带血的脓包…… 初始之章·张勋 以下内容为张勋视角 年9月15日...
    茶点故事阅读 36,534评论 2 327
  • 正文 我和宋清朗相恋三年,在试婚纱的时候发现自己被绿了。 大学时的朋友给我发了我未婚夫和他白月光在一起吃饭的照片。...
    茶点故事阅读 38,673评论 1 341
  • 序言:一个原本活蹦乱跳的男人离奇死亡,死状恐怖,灵堂内的尸体忽然破棺而出,到底是诈尸还是另有隐情,我是刑警宁泽,带...
    沈念sama阅读 34,339评论 4 330
  • 正文 年R本政府宣布,位于F岛的核电站,受9级特大地震影响,放射性物质发生泄漏。R本人自食恶果不足惜,却给世界环境...
    茶点故事阅读 39,955评论 3 313
  • 文/蒙蒙 一、第九天 我趴在偏房一处隐蔽的房顶上张望。 院中可真热闹,春花似锦、人声如沸。这庄子的主人今日做“春日...
    开封第一讲书人阅读 30,770评论 0 21
  • 文/苍兰香墨 我抬头看了看天上的太阳。三九已至,却和暖如春,着一层夹袄步出监牢的瞬间,已是汗流浃背。 一阵脚步声响...
    开封第一讲书人阅读 32,000评论 1 266
  • 我被黑心中介骗来泰国打工, 没想到刚下飞机就差点儿被人妖公主榨干…… 1. 我叫王不留,地道东北人。 一个月前我还...
    沈念sama阅读 46,394评论 2 360
  • 正文 我出身青楼,却偏偏与公主长得像,于是被迫代替她去往敌国和亲。 传闻我的和亲对象是个残疾皇子,可洞房花烛夜当晚...
    茶点故事阅读 43,562评论 2 349

推荐阅读更多精彩内容