基于负采样的skip-garm的语言模型实现－R

基本思路：

已知词w，在文章中统计其上下文u1，u2。。。在负样本集中选取负样本u3、u4。。。

词w的词向量与其对应的每个样本向量乘积，利用sigmod函数求得概率估计值。与标记值target的残差求梯度下降，优化输入词向量、权值向量、偏置向量。

问题：

初始化输入词向量、权值向量、偏置向量时如果值过大，那么wx＋b就过大，导致sigmod值区域正负无穷，残差值出现INF值。

结果：

1、本次只利用了34句关于找工作的话题的话语来训练模型，模型最后的结果：

string1 <- "找好工作，主要是有经验"
string2 <- "工作找经验"


pro1 <- getpro(string1) #23.7
pro2 <- getpro(string2) #4.91

         2、训练的词向量，降维展示在二维空间内：

“理解”、“沟通”、“长得帅” 三个词的距离很接近。。。。

原来长得帅也是找工作的一个充分条件。。。。

#设置工作目录

setwd("../buaa/sahomework")
#读取数据
answer <- read.csv("./data/answer3new",
                   encoding = "utf-8",
                   sep = ",",
                   header = FALSE,
                   stringsAsFactors = FALSE)


#处理数据dataframe
names(answer) <- c("questionid","id","username","zan","answer")
answer$questionid <- as.character(answer$questionid)
answer$id <- as.character(answer$id)


#先拿小样本尝试,取某一个问题的全部回答“655467276313526272”
answers <- answer[which(answer$questionid == "655467276313526272"),]


#answers分词
library(jiebaR)
wk <- worker()
anscorpus <- data.frame("anscorpus" = wk[answers$answer])


#先不处理停顿次
#停顿次是否需要去掉
# removeStopWords = function(x,words) {
#   ret = character(0)
#   index <- 1
#   it_max <- length(x)
#   while (index <= it_max) {
#     if (length(words[words==x[index]]) <1) 
#       ret <- c(ret,x[index])
#     index <- index +1
#   }
#   ret
# }
# stopwords <- data.frame("stopwords" = "的")




# corpus <- lapply(as.character(anscorpus), removeStopWords,stopwords)
# corpus <- data.frame("corpus" = unlist(strsplit(as.character(anscorpus),split=",")))
corpus <- anscorpus
#语料库落地存储
write.csv(corpus,file = "data/words.csv",col.names = FALSE,row.names = FALSE)


#处理corpus，按照词频进行排序，序号为该词的index ,负采样方便 190个词
corpusFreq <- data.frame(table(corpus))
corpusFreq <- corpusFreq[order(corpusFreq$Freq,decreasing = T),]
corpusFreq$id <- c(1:190)
summary(corpusFreq)


#词云展示词频
install.packages("wordcloud")
library(RColorBrewer)
library(wordcloud)
par(family='STXihei') #不起作用，需要在wordcloud中设置？？
png(file = "wordcloud.png",bg = "white",width = 480,height = 480)
colors = brewer.pal(8,"Dark2")
wordcloud(corpusFreq$corpus,corpusFreq$Freq,
          scale=c(3,0.5),
          min.freq=-Inf,
          max.words=190,
          colors=colors,
          random.order=F,
          random.color=F,
          ordered.colors=F,
          family='STXihei')
dev.off()


#把回答翻译成id的文章 34句话, 302个词的词串
#以便提取上下文词语,句末添加"." -- 暂时不添加
charaIndex <- ""
unuseChara <- 0
for(i in c(1:dim(corpus)[1])){
  if(corpus[i,1] %in% corpusFreq$corpus){
    # print(i)
    chara <- corpusFreq[corpusFreq$corpus == corpus[i,1], 3]
    charaIndex <- paste(charaIndex, chara,sep = ",")
  }else{
      unuseChara <- unuseChara + 1
    }
}
# for(j in c(1:dim(answers)[1])){
#   charactors <- unlist(strsplit(answers[j,5],split = ""))#列名不能提取列？？
#   len <- length(charactors)
#   
#   for (i in c(1:len)) {
#     if(charactors[i] %in% corpusFreq$corpus){
#       chara <- corpusFreq[corpusFreq$corpus == charactors[i], 3]
#       charaIndex <- paste(charaIndex, chara,sep = ",")
#     }else{
#       unuseChara <- unuseChara + 1
#     }
#   }
#   # charaIndex <- paste(charaIndex,".",sep = ",")
# }


#生成上下文，corpusFreq$context纪录该词所有的num_skip＝2的上下文
corpusFreq$context <- NULL
# num_skip <- 2
# batch_size <- 190


  chara <- unlist(strsplit(charaIndex,split = ","))
  chara <- chara[-1]#chara[1]是空 218个词
  for (i in c(1:length(chara))) {
    if(i > 1){
      oldContext <- corpusFreq[which(corpusFreq$id == chara[i]),4]
      corpusFreq[which(corpusFreq$id == chara[i]),4] <- paste(oldContext,chara[i-1],sep = ",") 
    }
    if(i < length(chara)){
      oldContext <- corpusFreq[which(corpusFreq$id == chara[i]),4]
      corpusFreq[which(corpusFreq$id == chara[i]),4] <- paste(oldContext,chara[i+1],sep = ",") 
    }
  }
  names(corpusFreq)[4] <- "context"
  #对上下进行修正，没有的补上
  
  
#构建负采样矩阵190*5
valid_sample <- matrix(0,nrow = 190,ncol = 5)


for(i in c(1:dim(corpusFreq)[1])){
  quene <- c(1:dim(corpusFreq)[1])
  quene[-i]
  valid_sample[i,] <- sample(quene,5,replace = F)
}




#构建logits矩阵,每一行是一个词的2个正样本＋5个负样本 结果是190＊7
contextmatrix <- matrix(0,nrow = 190,ncol = 2)
for(i in c(1:dim(corpusFreq)[1])){
  contextlist <- unlist(strsplit(corpusFreq[i,4],split = ","))
  if(contextlist[1] == "NA"){
    context <- contextlist[c(2:3)]
  }else{
    context <- contextlist[c(1:2)]
  }
  contextmatrix[i,] <- context
}
contextM <- data.frame(cbind(contextmatrix,valid_sample))
# contextM <- lapply(contextM[,],as.numeric)
# contextM <- data.frame(contextM)
# contextM[is.na(contextM)] <- 0
names(contextM) <- c("prefix","suffix","valid1","valid2","valid3","valid4","valid5")


#标记矩阵
target1 <- matrix(1,nrow = 190,ncol = 2)
target2 <- matrix(0,nrow = 190,ncol = 5)
target <- cbind(target1,target2)


# #交叉熵递归下降 求解train_input
# #交叉熵：logits - logits * target + ln(1 + exp(-logits))
# cross_entropy <- logits - logits * target + log(1 + exp(-logits))
# sum_row <- data.frame(rowSums(cross_entropy))


#轮训对一个样本进行随机梯度下降
sigmod = function(x){
  return(1 / 1 + exp(-x))
}


logits <- logits <- matrix(0,nrow = 190,ncol = 7)


#x 190*128 labels 190*1 W 190*128 B 190*1 
nce_weight <- matrix(runif(24320,-0.1,0.1),nrow = 190,ncol = 128)
nce_biases <- matrix(runif(190,-0.1,0.1),nrow = 190)


train_inputs <- matrix(runif(24320,-0.1,0.1),nrow = 190,ncol = 128)
# nce_weight <- nce_weight2
# nce_biases <- nce_biases2
# train_inputs <- train_inputs2
# train_labels <- matrix(runif(190,-1,1),nrow = 190)


#logit矩阵，方便调试sigmod函数，防止出现正负无穷
genrate_logits = function(){
  logits <- matrix(0,nrow = 190,ncol = 7)
  for(i in c(1:dim(train_inputs)[1])){
    x <- t(data.frame(train_inputs[i,]))
    w <- t(data.frame(nce_weight[as.integer(contextM[i,]),]))
    logits[i,] <- x %*% w + nce_biases[i]
  }
  return(logits)
}
logits2 <- genrate_logits()


#梯度下降
maxiter <- 190
# minerror <- 0.01
step <- 0.01
# newerror <- 1
iter <- 0 #循环次数
len <- dim(train_inputs)[1]
i <- 1 #train_inputs中的第i个样本
while(iter <= maxiter){
  # print("=========")
  des <- matrix(0,nrow = 128,ncol = 1)
  iter <- iter + 1
  if(i > len){i <- i %% len}
  print(i)
  x <- t(data.frame(train_inputs[i,]))
  w <- t(data.frame(nce_weight[as.numeric(contextM[i,]),]))
  #wx + b 的sigmod值，1*7矩阵，计算每个样本的残差进行修正
  logits[i,] <- x %*% w + matrix(nce_biases[as.numeric(contextM[i,]),],nrow = 1,ncol = 7)
  
  
  #依次更新weight和biase
  for(j in c(1:length(logits[1,]))){
    #出现了－Inf和Inf，然后NaN,sigmod函数当值较大或者较小时函数值区域无穷，
    #缩小初始化随机变量的取值范围
    des <- (sigmod(logits[i,j]) - target[i,j]) * as.matrix(train_inputs[i,])#128*1
    #更新x
    train_inputs[i,] <- as.matrix(train_inputs[i,]) - step * des
    # print("=====更新train=====")
    print(des[1,1])
    #更新w
    nce_weight[as.integer(contextM[i,j]),] <- 
      as.matrix(nce_weight[as.integer(contextM[i,j]),]) - step * des
    nce_biases[as.integer(contextM[i,j]),] <- nce_biases[as.integer(contextM[i,j]),] - step * (t(des) %*% des)
    
  }
  i <- i + 1
}
  
#对词向量进行可视化
#pca分析
pca <- princomp(train_inputs[,],cor = TRUE,scores = TRUE)
plot(pca, type="lines")
biplot(pca)


#计算MDS
dis <- dist(train_inputs,diag = TRUE,upper = TRUE )
# fit <- hclust(dis,method = "ward.D")
# plot(fit)
dismatrix <- as.matrix(dis)
mds <- cmdscale(dismatrix,k = 2)
par(family = "STXihei")
plot(mds[,1],mds[,2],type = "n",col = "red")
text(mds[,1],mds[,2],labels = corpusFreq$corpus,cex = 0.5,col = "black")


#计算语句出现概率
getpro = function(s){
  testcorpus <- data.frame("corpus" = wk[s])
  for (i in c(1:dim(testcorpus)[1])) {
    testcorpus$id[i] <- corpusFreq[as.character(corpusFreq$corpus) == testcorpus[i,1],3]
  }
  pro <- 0
  len <- dim(testcorpus)[1] - 1
  for (i in c(2:len)){
    prepro <- sigmod(matrix(train_inputs[testcorpus[i,2],],nrow = 1,ncol = 128) %*% nce_weight[testcorpus[i-1,2],] + nce_biases[testcorpus[i-1,2],])
    sufpro <- sigmod(matrix(train_inputs[testcorpus[i,2],],nrow = 1,ncol = 128) %*% nce_weight[testcorpus[i+1,2],] + nce_biases[testcorpus[i+1,2],])
    proi <- prepro * sufpro
    pro <- pro + proi
  }
  return(pro)
}


string1 <- "找好工作，主要是有经验"
string2 <- "工作找经验"


pro1 <- getpro(string1) #23.7
pro2 <- getpro(string2) #4.91