概率圖模型：
用圖的表示法來描述一系列隨機(jī)變量之間的條件獨(dú)立性關(guān)系的模型改执。
內(nèi)容：

• 樸素貝葉斯分類器
• 隱馬爾科夫模型(HMM)

1. 圖論入門

圖(graph)：
節(jié)點(diǎn)(node)集合：包含頂點(diǎn)
邊(edge)集合：包含頂點(diǎn)之間的邊
一個(gè)圖就是一些點(diǎn)及其之間的連接進(jìn)行的描述
有向圖(directed graph)
源點(diǎn)(source) 到目標(biāo)點(diǎn)(target)
尾頂點(diǎn)(tail vertex)到頭頂點(diǎn)(head vertex)
無向圖(undirected graph)

鄰接矩陣(adjacency matrix)
如果有??個(gè)頂點(diǎn)校辩，鄰接矩陣就是?? × ??的矩陣翻默；如果有連通就是1，沒有連通就是0
由于矩陣不對(duì)稱抒痒，我們知道是有向圖
路徑(path)：如果從頂點(diǎn)????開始幌绍，沿著邊在圖中移動(dòng)，穿過任意數(shù)量的頂點(diǎn)故响，最后抵達(dá)????傀广。那么中間經(jīng)過的邊構(gòu)成了路徑

概率圖模型(probabilistic graphical model)或者簡稱圖模型(graphical model)
節(jié)點(diǎn)代表隨機(jī)變量
邊代表依賴關(guān)系

2. 貝葉斯定理

• 兩個(gè)事件A和B
  

  事件A：病人患有闌尾炎樟蠕，事件B：病人的白細(xì)胞計(jì)數(shù)高贮聂，已知事件B的情況下靠柑，事件A的條件概率：

• 貝葉斯定理

  
  概念：
  Pr (??) ：先驗(yàn)概率(prior probability)
  Pr(??|??)：后驗(yàn)概率(posterior probability)
  例子：
  病人通常患有闌尾炎吓懈，白細(xì)胞計(jì)數(shù)偏高
  已知事件B歼冰，白細(xì)胞計(jì)數(shù)(容易觀測(cè))偏高的請(qǐng)況下，病人患有闌尾炎(不容易觀測(cè))的概率會(huì)改變
  已知患有闌尾炎其白細(xì)胞計(jì)數(shù)增高的概率Pr(??|??)很好計(jì)算

3. 條件獨(dú)立

統(tǒng)計(jì)性獨(dú)立
兩個(gè)隨機(jī)變量A和B聯(lián)合概率就是它們的(邊緣)概率的乘積
Pr(?? ∩ ??) = Pr(??) ? Pr (??)
有時(shí)候兩個(gè)變量不一定是統(tǒng)計(jì)性獨(dú)立的耻警，但對(duì)第三個(gè)變量C進(jìn)行觀察隔嫡，可能會(huì)發(fā)現(xiàn)它們之間變成了獨(dú)立的
Pr(?? ∩ ??|??) = Pr(??|??) ? Pr (??|??)

4. 貝葉斯網(wǎng)絡(luò)

• 貝葉斯網(wǎng)絡(luò)(Bayesian network)
  一種涉及有向無環(huán)圖的圖模型
  雙親(parent)：有向邊的尾節(jié)點(diǎn)
  孩子(child)或后代(descendant)：頭節(jié)點(diǎn)
  節(jié)點(diǎn)A到節(jié)點(diǎn)B有一條路徑，節(jié)點(diǎn)B就是節(jié)點(diǎn)A的一個(gè)后代或孩子
  直系后代(direct descendant)：節(jié)點(diǎn)A直接連節(jié)點(diǎn)B

• 局部馬爾科夫性
  給定雙親榕栏，每個(gè)節(jié)點(diǎn)就條件獨(dú)立于網(wǎng)絡(luò)中不是它后代的所有其他節(jié)點(diǎn)
  我們只需要關(guān)心邊就行
  局部馬爾科夫性可以幫助我們對(duì)模型中所有隨機(jī)變量的聯(lián)合概率函數(shù)進(jìn)行因式分解
  三個(gè)變量的概率乘法法則(G,J,U)
  Pr(??,??,??) = Pr(??|??,??) ? Pr (??|??) ? Pr(??)
  利用貝葉斯網(wǎng)絡(luò)的局部馬爾科夫性
  Pr(??,??,??) = Pr(??|??) ? Pr(??|??) ? Pr(??)
  節(jié)約計(jì)算量畔勤、存儲(chǔ)量
  獨(dú)立關(guān)系可以分解蕾各，任務(wù)也可以大大簡化

5. 樸素貝葉斯分類器

給定了Sentiment節(jié)點(diǎn)妨托，所有其他節(jié)點(diǎn)都是相互獨(dú)立的

要做一個(gè)分類器：
目標(biāo)是選出類別????吝羞，他們能夠最大化后驗(yàn)概率Pr(????|??1, … , ????)

預(yù)測(cè)電影評(píng)論里的情緒

在論壇、在線評(píng)論和社交媒體的世界里面敦腔，有一種任務(wù)恨溜，情感分析(sentiment analysis)符衔。

• 對(duì)一段文字進(jìn)行分析糟袁，確定作者要表達(dá)的情感
• 收集在線評(píng)論、博客文字或者推特上的推文
• 構(gòu)建一個(gè)模型來預(yù)測(cè)用戶的感受是正面還是負(fù)面
• 或者更細(xì)微的情緒项戴，輕微負(fù)面和非常負(fù)面等

《Learning word vectors for sentiment analysis》
25000條影評(píng)的訓(xùn)練集和另外25000條的測(cè)試集

tm包(text mining)

學(xué)會(huì)讀懂corpus的格式：
動(dòng)態(tài)語料庫(Volatile Corpus形帮，作為R對(duì)象保存在內(nèi)存中)和靜態(tài)語料庫(Permanent Corpus周叮，R 外部保存)仿耽。
所對(duì)應(yīng)的函數(shù)分別是 VCorpus() 和 PCorpus()

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

x：
DirSource：處理目錄
VectorSource：由文檔構(gòu)成的向量
DataframeSource：數(shù)據(jù)框，就像CSV 文件

• 每個(gè)文件采用<counter>_<score>.txt的格式來取名的水慨，這個(gè)信息會(huì)放到Vcorpus()函數(shù)創(chuàng)建的語料庫對(duì)象的meta部分晰洒，可以用meta調(diào)看
• 評(píng)分(score)部分是一個(gè)介于0到10的數(shù)字，較大代表正面評(píng)分治宣，較小代表負(fù)面評(píng)分侮邀，評(píng)分范圍0-4贝润，7-10
• 利用正則表達(dá)規(guī)則打掘，及函數(shù)sub()從文檔名列表中取出評(píng)分部分

描述在辭典里面的特定單詞是否出現(xiàn)二元特征

• 負(fù)面boring,cliché和horrible(無聊尊蚁、陳詞濫調(diào)和可怕)
• 正面inspiring,enjoyable,moving和excellent(鼓舞人心横朋、愉快的、感人的和優(yōu)秀的)

預(yù)處理 tm_map() 和content_transformer()
單詞轉(zhuǎn)換成小寫格式(Excellent=excellent)
刪除標(biāo)點(diǎn)符號(hào)晰甚、數(shù)字压汪、停用詞(stop words)
停用詞：the, and, in和be
標(biāo)記化(tokenization)：文本拆分成單詞

文檔-詞條矩陣(document term matrix)
行是文檔古瓤，列是辭典里的單詞
矩陣?yán)锩婷總€(gè)元素是一個(gè)二元值落君，1對(duì)應(yīng)的事實(shí)是：列號(hào)代表的單詞會(huì)在行號(hào)代表的影評(píng)中出現(xiàn)绎速。例如纹冤，第一列對(duì)應(yīng)的單詞action购公，第四行對(duì)應(yīng)代表第四個(gè)影評(píng)宏浩，在該矩陣(4,1)這個(gè)位置的元素是1比庄，代表第四個(gè)影評(píng)中包含了單詞action

tm提供了DocumentTermMatrix()這個(gè)函數(shù)
一共251136列佳窑，代表語料庫里面找到的不同單詞的數(shù)量父能，這個(gè)矩陣是非常稀疏的
從稀疏和非稀疏的比例來看法竞，25000條觀測(cè)數(shù)據(jù)去學(xué)習(xí)251136個(gè)特征的問題也很難岔霸。需要去除稀疏性removeSpareTerms呆细，這樣特征數(shù)降低到1710個(gè)八匠，觀測(cè)數(shù)據(jù)量依然是25000梨树，最大允許稀疏度99%抡四，實(shí)現(xiàn)稀疏程度是95%。

波特詞干提取器(Porter Stemmer)
像movie和movies這樣的單詞是作為不同的單詞進(jìn)行處理的淑履，即使它們是同一個(gè)詞秘噪，只是詞尾有點(diǎn)變化而已指煎。
詞形變化(inflection)是一種改變單詞的基本形式或詞目(lemma)使之與另一個(gè)單詞在時(shí)態(tài)至壤、格、性別字逗、單復(fù)數(shù)等屬性上呼應(yīng)的過程葫掉。
tm包支持詞干提取(stemming)俭厚，去除單詞的詞形變化的過程驶臊，只保留詞干关翎。

library(NLP)
library(tm)

#設(shè)置文件路徑
path_to_neg_folder<-"aclImdb/train/neg"
path_to_pos_folder<-"aclImdb/train/pos"

#讀取文件DirSource()路徑函數(shù)
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"))
#合并兩個(gè)數(shù)據(jù)
nb_all <- c(nb_pos,nb_neg)

#觀察數(shù)據(jù)
View(nb_all[[2]])
meta(nb_all[[20000]])

#獲得所有文件名纵寝，后面根據(jù)文件名解析出評(píng)分
ids<-sapply(1:length(nb_all),function(x) meta(nb_all[[x]],"id"))
head(ids)

#解析評(píng)分爽茴，大于等于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)) #移除數(shù)字
nb_all <- tm_map(nb_all, content_transformer(removePunctuation)) #移除標(biāo)點(diǎn)符號(hào)
nb_all <- tm_map(nb_all, content_transformer(tolower)) #轉(zhuǎn)換為小寫
nb_all <- tm_map(nb_all, content_transformer(removeWords), stopwords("english"))
nb_all <- tm_map(nb_all, content_transformer(stripWhitespace)) #去除空格

#將數(shù)據(jù)轉(zhuǎn)換為矩陣
nb_dtm <-DocumentTermMatrix(nb_all)
dim(nb_dtm)

#壓縮矩陣胧沫，去掉為空的項(xiàng)
nb_dtm<-removeSparseTerms(x=nb_dtm, sparse = 0.99)
dim(nb_dtm)

nb_dtm <- weightBin(nb_dtm) ## 所有元素變換成二元因子
inspect(nb_dtm[1000:1006,100:106]) #查看數(shù)據(jù)框
nb_df <- as.data.frame(as.matrix(nb_dtm)) #將矩陣變?yōu)閐ataframe

#劃分訓(xùn)練集和測(cè)試集
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函數(shù)進(jìn)行學(xué)習(xí)
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)
#輸出結(jié)果江场，可以達(dá)到81%的準(zhǔn)確率

#修正方法一后的代碼
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)

• 修正方法一后的代碼
• 修正方法二后的代碼
  正則化技術(shù)：訓(xùn)練樸素貝葉斯模型中運(yùn)用添加平滑(additive smoothing)技術(shù)址否，也叫做拉普拉斯平滑(lapacian smoothing)技術(shù)
  解決矩陣稀疏：給一些沒有出現(xiàn)過的詞一些極小的概率佑附。
  假設(shè)在文本分類中音同，有3個(gè)類，C1顿膨、C2恋沃、C3囊咏，在指定的訓(xùn)練樣本中梅割，某個(gè)詞語K1葛家，在各個(gè)類中觀測(cè)計(jì)數(shù)分別為0惦银，990扯俱，10迅栅，K1的概率為0晴玖，0.99呕屎，0.01秀睛，對(duì)這三個(gè)量使用拉普拉斯平滑的計(jì)算方法如下： 1/1003 = 0.001蹂安，991/1003=0.988，
  11/1003=0.011
• 修正方法三
  用PCA減少特征量
• 修正方法四
  假定某個(gè)影評(píng)里所有的單詞都是相互獨(dú)立的缴阎，這不符合實(shí)際简软，例如not bad痹升，其實(shí)并不是表示bad视卢。否定是文本處理中的最困難的問題之一据过。還有挖苦绳锅、諷刺鳞芙、包含其他人想法的句子等。

6.隱馬爾科夫模型

隱馬爾可夫模型(Hidden Markov model)：
對(duì)序列進(jìn)行預(yù)測(cè)和建模的帶有重復(fù)性結(jié)構(gòu)的貝葉斯模型
應(yīng)用1：對(duì)DNA基因序列進(jìn)行建模
應(yīng)用2：對(duì)組成英語文字的字母序列進(jìn)行建模

NLP中晨汹，對(duì)詞性標(biāo)注的應(yīng)用
詞性標(biāo)注器的任務(wù)是讀取一個(gè)句子并返回對(duì)應(yīng)該句子中單詞的詞性標(biāo)簽淘这。例如：The返回determiner(限定詞)铝穷，對(duì)單詞task返回singular noun(單數(shù))曙聂，諸如此類宁脊。
單詞作為觀測(cè)數(shù)據(jù)榆苞，詞性標(biāo)注作為隱含狀態(tài)庐氮。
前者可以觀測(cè)弄砍，后者想要判定音婶。
例如衣式，命名實(shí)體識(shí)別碴卧，目標(biāo)是在一個(gè)句子中識(shí)別出指代個(gè)人住册、地點(diǎn)荧飞、組織和其他實(shí)體的名詞的單詞叹阔。

5個(gè)部分耳幢，后面3個(gè)部分涉及概率
起始概率向量(starting probability vector)
轉(zhuǎn)移概率矩陣(transition probability matrix)：狀態(tài)????到狀態(tài)????+1的概率矩陣
發(fā)出概率矩陣(emission probability matrix)遇到每種狀態(tài)睛藻，在辭典里每個(gè)符號(hào)的發(fā)出概率
例如某些單詞(例如bank可以是名詞也可以是動(dòng)詞)會(huì)被標(biāo)記上
多個(gè)詞性標(biāo)記

預(yù)測(cè)啟動(dòng)子基因序列

DNA分子的基本組成是4種被稱為核苷酸(nucleotide)的基本分子修档。胸腺嘧啶吱窝、胞嘧啶院峡、腺嘌呤照激、鳥嘌呤(Thymine, Cytosine, Adenine, Guanine)四種分子在DNA鏈中的順序編碼了DNA所攜帶的遺傳信息俩垃。

目標(biāo)：在DNA鏈條中找到啟動(dòng)子序列口柳。這些序列是核苷酸的特殊序列跃闹，它們?cè)谡{(diào)節(jié)一種被稱為基因轉(zhuǎn)錄(gene transcription)的遺傳過程中扮演了重要角色。是DNA中信息被讀取的機(jī)制第一步肌访。

用HMM構(gòu)建識(shí)別非啟動(dòng)子基因序列和啟動(dòng)子基因序列的模型吼驶，構(gòu)建一個(gè)針對(duì)啟動(dòng)子的HMM和一個(gè)針對(duì)非啟動(dòng)子的HMM旨剥，挑出能對(duì)一個(gè)測(cè)試序列產(chǎn)生最高概率的模型來標(biāo)記該序列轨帜。

####例子1：預(yù)測(cè)啟動(dòng)子基因序列
promoters <- read.csv("promoters.data", header=F, dec=",", strip.white=TRUE, stringsAsFactors = FALSE)
#V1:+表示啟動(dòng)子蚌父，-表示非啟動(dòng)子
#V2:特定序列的識(shí)別符
#V3:核苷酸序列本身（即觀測(cè)序列苟弛，同時(shí)也是隱藏序列）
promoters[1,]

#數(shù)據(jù)拆分成啟動(dòng)子和非啟動(dòng)子膏秫。
#subset表示根據(jù)條件來篩選子集缤削。這里的3表示選擇第3列亭敢，丟棄掉1帅刀，2列
positive_observations <- subset(promoters, V1=='+', 3)
negative_observations <- subset(promoters, V1=='-', 3)

#在每個(gè)序列之前加上S扣溺，表示數(shù)據(jù)的開始娇妓，在每個(gè)結(jié)尾加上X，表示數(shù)據(jù)的結(jié)束
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]

#將一串字符串着绷，按每個(gè)字母分開,得到一個(gè)列表
positive_observations<-strsplit(positive_observations,"")
negative_observations<-strsplit(negative_observations,"")
head(positive_observations[1])

#定義隱藏狀態(tài)荠医。我們的隱藏狀態(tài)有以下6個(gè)（S,X,a,c,g,t）
states <- c("S", "X", "a", "c", "g", "t")
#定義觀測(cè)狀態(tài)彬向。我們的觀測(cè)狀態(tài)也有6個(gè)
symbols <- c("S", "X", "a", "c", "g", "t")
#定義初始概率娃胆，也即pi里烦，表示剛開始的時(shí)候胁黑，只有S丧蘸，即從S開始。
startingProbabilities<-c(1,0,0,0,0,0)
#定義發(fā)射概率冗懦，也即觀測(cè)狀態(tài)轉(zhuǎn)移概率矩陣 B披蕉。這里是一個(gè)對(duì)角矩陣没讲，對(duì)角線都為1爬凑，其余為0
#代表只能從S到S嘁信，從a到a潘靖，從c到c卦溢，從g到g单寂，從t到t
emissionProbabilities<-diag(6)
colnames(emissionProbabilities)<-states #列名為狀態(tài)值
rownames(emissionProbabilities)<-symbols #行名為觀測(cè)值
emissionProbabilities

#根據(jù)我們的樣本蘸劈，來計(jì)算轉(zhuǎn)移概率矩陣昵时。
calculateTransitionProbabilities <- function(data, states) {
 #初始化轉(zhuǎn)移狀態(tài)矩陣椒丧，剛開始都為0
    transitionProbabilities<-matrix(0,length(states),length(states))
    colnames(transitionProbabilities)<-states
    rownames(transitionProbabilities)<-states
#按順序循環(huán)數(shù)據(jù)中的每一個(gè)字母壹甥，統(tǒng)計(jì)從狀態(tài)A狀態(tài)B的次數(shù)，并放到矩陣中壶熏。即匯總出每一個(gè)狀態(tài)轉(zhuǎn)移的總數(shù)
    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
    }
    #根據(jù)次數(shù)矩陣句柠，使用sweep函數(shù)來計(jì)算概率。
    #swepp中的第二個(gè)參數(shù)1棒假，代表按行計(jì)算溯职；2帽哑，代表按列計(jì)算
    #rowSums函數(shù)代表按行進(jìn)行求和
    #整個(gè)函數(shù)的意思就是谜酒，用每一行的元素除以這一行的數(shù)據(jù)總和，得到歸一化的概率妻枕；
    transitionProbabilities<-sweep(transitionProbabilities, 1, rowSums(transitionProbabilities), FUN="/")
    return(transitionProbabilities)
}

#這里相當(dāng)于把negative_observations從原來的列表轉(zhuǎn)換為了一個(gè)向量
#即僻族，把原來每一行數(shù)據(jù)，都進(jìn)行了連接屡谐，形成了一個(gè)長向量述么，向量長度為原來的行數(shù)*每行的字母個(gè)數(shù)
negative_observation<-Reduce(function(x,y) c(x, y), negative_observations, c())
#使用非啟動(dòng)子基因序列的樣本來訓(xùn)練轉(zhuǎn)移概率矩陣。
(transitionProbabilitiesNeg  <- calculateTransitionProbabilities(negative_observation, states))

#使用HMM的五個(gè)參數(shù)來初始化隱馬爾可夫模型
library("HMM")
negative_hmm = initHMM(states, symbols, startProbs=startingProbabilities, transProbs=transitionProbabilitiesNeg, emissionProbs=emissionProbabilities)

#交叉檢驗(yàn)愕掏。每次我們從啟動(dòng)子基因序列的樣本中拿出一條數(shù)據(jù)作為檢驗(yàn)數(shù)據(jù)度秘，剩下的作為訓(xùn)練集數(shù)據(jù)
#先用剩下的數(shù)據(jù)來構(gòu)建HMM模型，此時(shí)的模型是根據(jù)啟動(dòng)子基因序列來構(gòu)建的
#然后饵撑，我們用剩下的這條檢驗(yàn)數(shù)據(jù)剑梳，分別帶入到之前negative_hmm模型和現(xiàn)在的positive_hmm模型中唆貌，采用向前算法來計(jì)算出現(xiàn)該基因序列的概率
#理論上，因?yàn)檫@條檢驗(yàn)數(shù)據(jù)是來自于啟動(dòng)子基因序列阻荒，因此挠锥，通過negative_hmm模型計(jì)算出來的概率應(yīng)該小于使用positive_hmm模型計(jì)算出來的概率。
#統(tǒng)計(jì)錯(cuò)誤率侨赡，我們即可知道模型的好壞
incorrect<-0 #定義錯(cuò)誤次數(shù)統(tǒng)計(jì)變量
for (obs in 1:length(positive_observations)) {
#使用啟動(dòng)子基因序列，構(gòu)造啟動(dòng)子基因序列模型粱侣，方便后面進(jìn)行對(duì)比  
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)

  #獲取檢驗(yàn)數(shù)據(jù)
test_observation<-positive_observations[[obs]]
final_index<-length(test_observation)

#將檢驗(yàn)數(shù)據(jù)分別帶入到兩個(gè)模型中羊壹，使用向前算法，分別計(jì)算使用這兩個(gè)模型得到該序列的概率
pos_probs<-exp(forward(positive_hmm,test_observation))
neg_probs<-exp(forward(negative_hmm,test_observation))

#計(jì)算出現(xiàn)該序列的概率之和齐婴。（上面得到的是序列中每個(gè)堿基出現(xiàn)的概率）
pos_seq_prob<-sum(pos_probs[,final_index])
neg_seq_prob<-sum(neg_probs[,final_index])

#如果使用positive模型得到的概率小于使用negative模型得到概率油猫，則錯(cuò)誤數(shù)+1
if (pos_seq_prob<neg_seq_prob) incorrect<-incorrect+1

}

#反過來，使用positive數(shù)據(jù)構(gòu)建模型柠偶，使negative數(shù)據(jù)進(jìn)行檢驗(yàn)情妖。因此以下代碼不再做解釋
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

}

#最后計(jì)算交叉檢驗(yàn)后的準(zhǔn)確度
(cross_validation_accuracy <- 1 - (incorrect/nrow(promoters)))

例子2: 分析英語單詞的字母順序模式（尋找隱藏序列的patten）

每個(gè)英語單詞，其字母的組成順序都是有一定規(guī)律的诱担。我們很少看到在一個(gè)單詞中毡证，有兩個(gè)元音字母連在一起。我們是否可以找到一個(gè)模型蔫仙，來體現(xiàn)出來這種規(guī)律呢料睛？
我們還是使用我們?cè)谏弦恢v中用到的文本數(shù)據(jù)。

#分析英語單詞的字母順序模式（尋找隱藏序列的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) #合并兩個(gè)數(shù)據(jù)
nb_all <- tm_map(nb_all, content_transformer(tolower)) #全部轉(zhuǎn)換為小寫

#因?yàn)閚b_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)) #把數(shù)字用N代替
texts<-sapply(texts, function(x) gsub("[[:punct:]]","P", x)) #把標(biāo)點(diǎn)符號(hào)用P代替
texts<-sapply(texts, function(x) gsub("[^a-zWNP]","O", x)) #其他符號(hào)用O代替
texts
#因?yàn)閠exts比較大，我們只取前40條數(shù)據(jù)施籍，并將其每個(gè)字母打散居扒，存入到列表中
big_text_splits<-lapply(texts[1:40], function(x) strsplit(x, ""))
big_text_splits<-unlist(big_text_splits, use.names = F) #將列表轉(zhuǎn)換為向量

#由于我們不知道單詞構(gòu)造到隱藏狀態(tài)，因此這里強(qiáng)行安了3個(gè)狀態(tài)
states <- c("s1", "s2", "s3")
numstates <- length(states)
symbols <- c(letters,"W","N","P","O") #觀測(cè)變量就是26個(gè)英文字母加上我們前面定義的幾個(gè)特殊字母
numsymbols <- length(symbols)

#初始化一個(gè)初始狀態(tài)概率矩陣pi丑慎。因?yàn)槲覀兊碾[藏狀態(tài)也是隨意給的喜喂，因此這里的初始狀態(tài)概率矩陣也可以隨機(jī)給一個(gè)
set.seed(124124)
startingProbabilities <- matrix(runif(numstates), 1, numstates)
startingProbabilities<-sweep(startingProbabilities, 1, rowSums(startingProbabilities), FUN="/")

#初始化一個(gè)轉(zhuǎn)移狀態(tài)矩陣
set.seed(454235)
transitionProbabilities<-matrix(runif(numstates*numstates),numstates,numstates)
transitionProbabilities<-sweep(transitionProbabilities, 1, rowSums(transitionProbabilities), FUN="/")

#初始化一個(gè)觀測(cè)狀態(tài)轉(zhuǎn)移概率矩陣（發(fā)射矩陣）
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 算法來學(xué)習(xí)參數(shù)。
hmm_trained <- baumWelch(hmm, big_text_splits)

hmm_trained$hmm

#根據(jù)學(xué)習(xí)后的參數(shù)立哑，我們來畫出轉(zhuǎn)移概率矩陣夜惭。轉(zhuǎn)移概率矩陣體現(xiàn)了在一個(gè)單詞中，每個(gè)字母出現(xiàn)的概率
#畫出從狀態(tài)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

#畫出從狀態(tài)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

#畫出從狀態(tài)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

#獲得隱含狀態(tài)轉(zhuǎn)移概率矩陣
(trained_transition_probabilities<-hmm_trained$hmm$transProbs)

#模擬給定隱馬爾可夫模型的狀態(tài)和觀測(cè)路徑铛绰。即根據(jù)模型構(gòu)造一個(gè)句子（單詞）
set.seed(9898)
simHMM(hmm_trained$hmm, 30)