75-R对邮件进行排序实现智能收件箱

《机器学习-实用案例解析》学习笔记

1、数据准备

数据下载：https://spamassassin.apache.org/old/publiccorpus/

参考谷歌Gmail服务，他们将邮件特征分为社交特征、内容特征、线程特征和标签特征。我们的数据中没有详细的时间戳及无法得知用户何时做了何种响应。但我们可以测量接收量，因此可以假设这种单向度量能够较好地代表数据中的社交特征类型。
社交特征。用同一主题邮件的发送间隔时间来决定邮件的重要性，很自然的方法就是计算收件人在收到邮件后过了多久才处理这封邮件，在给定特征集下，这个平均时间越短，说明邮件在所属类型中的重要性越高。
线程特征。匹配线程特征词项，比如“RE:”，线程很活跃，那么就比不活跃的更重要。
内容特征。抽取邮件正文中的词项，新来一封邮件当它们包含更多的特征词项时，说明更重要。
标签特征。暂不考虑。

我们只需要正常的邮件数据，对所有邮件信息按时间排序，然后将数据拆分为训练集和测试集。第一部分用于训练排序算法，第二部分用来测试模型效果。

> library(pacman)
> p_load(chinese.misc,stringr,dplyr,ggplot2)

> easy.ham.files <- dir_or_file("./easy_ham")
> easy.ham2.files <- dir_or_file("./easy_ham_2")
> hard.ham.files <- dir_or_file("./hard_ham")
> hard.ham2.files <- dir_or_file("./hard_ham_2")
> 
> emails <- c(easy.ham.files,easy.ham2.files,
+             hard.ham.files,hard.ham2.files) %>% unique()

邮件头信息：
From：这封邮件来自谁？使用来自该发件人的邮件量作为社交特征的表征量。
Date：何时收到这封邮件？作为时间度量。
Subj：这是一个活跃线程吗？如果来自一个已知线程，那么可以确定其活跃程度以作为线程特征。
正文：邮件内容是什么？找到最常出现的词项作为内容特征。
构造函数，在读取时从每一封邮件中抽取如上内容，将半结构化数据转换为高度结构化的训练数据集。

> pre_fun <- function(string) {
+   string <- str_replace_all(string,"\\s+"," ")
+   string <- tolower(string)
+   string <- str_replace_all(string,"[^a-z]"," ")
+   string <- str_replace_all(string,"\\s+"," ")
+   string <- str_trim(string,side = "both")
+   return(string)
+ }
> 
> # 数据读取函数
> read_fun <- function(f) {
+   if (!str_detect(f,"cmds")) {
+     f.txt <- readr::read_file(f)
+     # 抽取From
+     from <- str_extract_all(f.txt,"From:(.*)") %>% unlist
+     from <- ifelse(length(from>1),from[str_detect(from,"@")],from)
+     # 如果检测到邮箱地址在<>中，提取
+     if(str_detect(from,"<")) {
+       from <- str_extract(from,"<+(.*?)+>") %>% 
+         str_remove_all("<|>")
+     } else {
+       # 如果没有检测到尖括号，清除From和括号中的内容
+       from <- str_remove_all(from,"From: |\\(.*?\\)")}
+     # 抽取Date
+     date <- str_extract(f.txt,"Date:(.*)") %>% 
+       str_remove("Date: ")
+     # 抽取Subject
+     subject <- str_extract(f.txt,"Subject:(.*)") %>% 
+       str_remove("Subject: ")
+     # 按第一个空行切割，抽取邮件正文
+     message <- str_split_fixed(f.txt,"\n\n",2)
+     message <- message[1,2] %>% pre_fun
+     df <- tibble(from=from,date=date,subject=subject,message=message,id=f)
+     return(df)
+   }
+ }

> dt <- sapply(emails,read_fun) %>% 
+   do.call(bind_rows,.) %>% distinct()
> head(dt)

## # A tibble: 6 x 5
##   from       date       subject         message             id               
##   <chr>      <chr>      <chr>           <chr>               <chr>            
## 1 kre@munna~ Thu, 22 A~ Re: New Sequen~ date wed aug from ~ D:/R/data_set/sp~
## 2 steve.bur~ Thu, 22 A~ [zzzzteana] RE~ martin a posted ta~ D:/R/data_set/sp~
## 3 timc@2ubh~ Thu, 22 A~ [zzzzteana] Mo~ man threatens expl~ D:/R/data_set/sp~
## 4 monty@ros~ Thu, 22 A~ [IRR] Klez: Th~ klez the virus tha~ D:/R/data_set/sp~
## 5 Stewart.S~ Thu, 22 A~ Re: [zzzzteana~ in adding cream to~ D:/R/data_set/sp~
## 6 martin@sr~ Thu, 22 A~ Re: [zzzzteana~ i just had to jump~ D:/R/data_set/sp~

> mice::md.pattern(dt)
检查缺失值
##      from date message id subject  
## 6944    1    1       1  1       1 0
## 7       1    1       1  1       0 1
##         0    0       0  0       7 7

subject变量存在7个缺失值。
另外，我们还需要针对具体变量做更详细的检查。

> # 检查from中是否都存在@符号
> table(str_detect(dt$from,"@"))

## 
## TRUE 
## 6951

说明邮箱中发件人信息从邮箱格式上看是没有问题的。

随机查看30个date列的值：

> dt$date[sample(nrow(dt),30)]

##  [1] "Tue, 27 Aug 2002 21:36:22 -0400"      
##  [2] "Fri, 9 Aug 2002 20:09:02 -0700"       
##  [3] "Thu, 25 Jul 2002 04:56:39 -0400 (EDT)"
##  [4] "Sat, 24 Aug 2002 10:57:13 -0400 (EDT)"
##  [5] "Fri, 04 Oct 2002 10:03:14 +0300"      
##  [6] "Mon, 2 Sep 2002 09:33:47 -0400"       
##  [7] "Mon, 09 Sep 2002 12:29:51 -0400"      
##  [8] "Thu, 22 Aug 2002 12:39:47 -0300"      
##  [9] "Wed, 28 Aug 2002 07:45:18 -0700"      
## [10] "Tue, 24 Sep 2002 08:00:11 -0000"      
## [11] "Sat, 03 Aug 2002 22:31:23 -0700"      
## [12] "Mon, 07 Oct 2002 08:00:59 -0000"      
## [13] "20 Jul 2002 10:50:58 +1200"           
## [14] "Wed, 10 Jul 2002 16:34:42 -0700 (PDT)"
## [15] "Tue, 08 Oct 2002 13:28:56 +0100"      
## [16] "Tue, 20 Aug 2002 16:30:38 -0300"      
## [17] "Thu, 26 Sep 2002 08:01:56 -0000"      
## [18] "Tue, 1 Oct 2002 14:16:16 +0300 (EEST)"
## [19] "Mon, 30 Sep 2002 15:55:47 -0400"      
## [20] "Thu, 18 Jul 2002 17:20:20 -0700 (PDT)"
## [21] "Tue, 20 Aug 2002 15:31:17 +0100"      
## [22] "03 Oct 2002 21:58:55 -0400"           
## [23] "Sun, 01 Dec 2002 18:03:10 -0700"      
## [24] "Thu, 18 Jul 2002 13:46:12 -0700 (PDT)"
## [25] "Sun, 29 Sep 2002 08:00:02 -0000"      
## [26] "Thu, 26 Sep 2002 15:32:19 -0000"      
## [27] "Wed, 31 Jul 2002 16:37:42 +0100"      
## [28] "Mon, 12 Aug 2002 09:29:38 +0100"      
## [29] "Sat Sep  7 04:38:51 2002"             
## [30] "Wed, 09 Oct 2002 08:00:35 -0000"

多抽样几次，可以发现date列的格式比较多，比如
"Sun, 15 Sep 2002 21:22:52 -0400"，
"01 Oct 2002 19:22:16 -0700"，
"Wed, 17 Jul 2002 20:58:30 -0700 (PDT)"，
"Tue, 24 Sep 2002 08:46:08 EDT"，
"Tue Sep 10 10:29:19 2002"，
需要重新整理成统一的格式。构建日期转换函数：

> trans_date <- function(string) {
+ 
+   string <- str_split(string," ") %>% unlist %>% 
+ 
+     str_remove_all("Sun|Mon|Tue|Wed|Thu|Fri|Sat|,") %>%
+ 
+     str_remove_all("[+|-](.*)") %>% str_remove_all("\\(.*\\)") %>%
+ 
+     str_remove_all("[A-Z]{2,}")
+   year <- string[nchar(string)==4]
+   month <- string[nchar(string)==3]
+   day <- string[nchar(string)==1|nchar(string)==2]
+   time <- string[nchar(string)==8]
+   string.new <- paste(day,month,year,time) %>% lubridate::dmy_hms()
+   return(string.new)
+ }
> 
> dt$date <- dt$date %>% trans_date
> dt$date[sample(nrow(dt),10)]

##  [1] "2002-07-15 03:00:01 UTC" "2002-10-08 08:01:21 UTC"
##  [3] "2002-08-29 08:32:08 UTC" "2002-09-25 08:00:22 UTC"
##  [5] "2002-10-08 08:01:05 UTC" "2002-09-12 09:05:50 UTC"
##  [7] "2002-09-30 22:00:02 UTC" "2002-08-06 16:50:07 UTC"
##  [9] "2002-07-10 16:05:42 UTC" "2002-10-08 08:00:31 UTC"

转换后的结果很规整，完全符合我们的要求。

> head(dt)

## # A tibble: 6 x 5
##   from      date                subject       message          id            
##   <chr>     <dttm>              <chr>         <chr>            <chr>         
## 1 kre@munn~ 2002-08-22 18:26:25 Re: New Sequ~ date wed aug fr~ D:/R/data_set~
## 2 steve.bu~ 2002-08-22 12:46:18 [zzzzteana] ~ martin a posted~ D:/R/data_set~
## 3 timc@2ub~ 2002-08-22 13:52:38 [zzzzteana] ~ man threatens e~ D:/R/data_set~
## 4 monty@ro~ 2002-08-22 09:15:25 [IRR] Klez: ~ klez the virus ~ D:/R/data_set~
## 5 Stewart.~ 2002-08-22 14:38:22 Re: [zzzztea~ in adding cream~ D:/R/data_set~
## 6 martin@s~ 2002-08-22 14:50:31 Re: [zzzztea~ i just had to j~ D:/R/data_set~

现在数据基本转换成了我们需要的样子，下面继续做一些必要的转换。将from和subject全部转换为小写，并且将整个数据框按date列排序。最后将数据拆分为训练集和测试集。

> dt$from <- tolower(dt$from)
> dt$subject <- tolower(dt$subject)
> dt <- arrange(dt,date)
> 
> set.seed(123)
> ind <- sample(1:nrow(dt),nrow(dt)*0.8,replace = T)
> train <- dt[ind,]
> test <- dt[-ind,]

2、邮件发送量权重计算策略

来自同一地址（from）的邮件越频繁，说明该邮件越重要。所以按邮件中的from计数来设计用于重要性排序的权重。

> p_load(ggplot2)
> from.weight <- train[,"from"] %>% group_by(from) %>% 
+   summarise(freq=n()) %>% arrange(-freq)
> head(from.weight)

## # A tibble: 6 x 2
##   from                             freq
##   <chr>                           <int>
## 1 rssfeeds@example.com              498
## 2 rssfeeds@spamassassin.taint.org   468
## 3 tomwhore@slack.net                112
## 4 garym@canada.com                  104
## 5 pudge@perl.org                    102
## 6 matthias@egwn.net                  86

> # 查看邮件数量最多的前30个账号
> from.weight %>% top_n(30) %>% 
+   ggplot(aes(freq,reorder(from,freq))) +
+   geom_bar(stat = "identity") +
+   theme_bw() +
+   labs(x="接收邮件数量",y="")
最密切的发件人

对发送量做对数转换。

> from.weight %>%
+   ggplot(aes(x=freq)) +
+   geom_line(aes(y=log10(freq)),col="green") +
+   geom_text(aes(500,2.5,label="对数变换")) +
+   geom_line(aes(y=log(freq)),col="red") +
+   geom_text(aes(500,6,label="自然对数变换")) +
+   theme_bw() +
+   labs(x="",y="接收的邮件量")
对数变换效果

做对数变换后曲线会更平缓，同时，自然对数变换相对对数变换程度更小，更能保留原始数据的一些差异，所以最终我们选择自然对数变换后的值作为发送量特征的权重。
但是在做对数变换时需要注意的是，如果观测值为1，转换后就为0，计算权重时0乘以其他任何值都为0。为了避免这种情况，在转换前一般对观测值都加1。

> # log1p()函数计算log(p+1)
> from.weight$freq <- log1p(from.weight$freq)
> # 检查下变换为的数据
> summary(from.weight$freq)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  0.6931  0.6931  1.3863  1.4869  1.7918  6.2126

3、邮件线程活跃度权重计算策略

从subject中查找“re:”，然后查找这个线程里面的其他邮件，并测量其活跃度。在短时间内有更多邮件发送的线程就更活跃，因此也更重要。

> # 提取包含“re:”的subject，并提取“re:”后面的内容作为主题
> threads.train <- train %>% filter(str_detect(subject,"re:"))
> 
> extract_subject <- function(string){
+   string <- str_split(string,"re:") %>% 
+               unlist %>% .[2] %>% str_trim()
+   return(string)
+ }
> threads.train$subject <- threads.train$subject %>% 
+   lapply(extract_subject) %>% unlist
> 
> # 分组统计数量
> threads.freq <- threads.train %>% group_by(subject) %>% 
+   summarise(freq=n()) %>% arrange(freq)

数据中存在freq<2的情况，是因为数据集在采集的时候存在一部分主题邮件是在采集时间开始之前发起的，这时候主题中也存在“re:”标记，但是该线程发起时间并不在数据集中，所以需要去掉这部分数据。

> # 线程时间跨度，即第一封邮件和最后一封邮件之间的时间间隔
> time_span <- function(df){
+   max.time <- max(df$date)
+   min.time <- min(df$date)
+   threads.span <- difftime(max.time,min.time,units = "secs")
+   df.new <- tibble(subject=df$subject[1],threads.span=threads.span)
+   return(df.new)
+ }
> 
> # 将数据框按subject拆分
> threads.train.split <- split.data.frame(threads.train,
+                                         threads.train$subject)
> 
> threads.span <- lapply(threads.train.split,time_span) %>% 
+   do.call(rbind.data.frame,.)

按主题合并两个数据框。

> subject.weight <- left_join(threads.freq,threads.span,by="subject") %>% 
+   # 转换为数值型
+   transform(threads.span=as.numeric(threads.span)) %>% 
+   filter(freq>=2 & threads.span!=0) %>% 
+   mutate(weight=freq/threads.span) %>% 
+   # 仿射变换
+   transform(weight=log10(weight)+10) %>% 
+   arrange(weight)
> head(subject.weight)

##                  subject freq threads.span   weight
## 1            activebuddy   17    820721053 2.316253
## 2            [zzzzteana]    6      8275106 3.860378
## 3 no matter where you go    4      2672629 4.175121
## 4                [sadev]    7      3325905 4.323188
## 5          [ilug-social]    4      1649403 4.384733
## 6          [razor-users]   16      5174599 4.490243

> summary(subject.weight)

##    subject               freq         threads.span           weight     
##  Length:287         Min.   : 2.000   Min.   :       16   Min.   :2.316  
##  Class :character   1st Qu.: 3.000   1st Qu.:    15482   1st Qu.:5.675  
##  Mode  :character   Median : 5.000   Median :    49344   Median :6.126  
##                     Mean   : 7.784   Mean   :  3094884   Mean   :6.115  
##                     3rd Qu.: 9.000   3rd Qu.:   145816   3rd Qu.:6.512  
##                     Max.   :41.000   Max.   :820721053   Max.   :9.097

从摘要中可以看到freq平均为7.784，threads.span平均为3094884，这样计算的weight将会很小，平均为2.515118e-06，在做对数转换时，就会得到负值：log10(7.784/3094884)=-5.600825。计算时权重不能为负值，所以这里进行仿射变换，简单地给所有转换值加10，以保证所有权重值为正数。

4、邮件内容中高频词项的权重策略

假设出现在活跃线程邮件主题中的高频词比低频词和出现在不活跃线程中的词项更重要。

> p_load(text2vec)
> 
> it <- itoken(threads.dt$message,ids = threads.dt$id,progressbar = F)
> 
> # 创建训练集词汇表
> vocab <- create_vocabulary(it)
> 
> # 去除停用词
> stopword <- readr::read_table("D:/R/dict/english_stopword.txt",
+                               col_names = F)
> 
> # 还是以对数转换计算高频词的权重
> term.weight <- anti_join(vocab,stopword,by=c("term"="X1")) %>% 
+   mutate(term.weight=log10(term_count)) %>% 
+   filter(term.weight>0)

5、训练和测试排序算法

一封邮件的整体权重（优先级）等于前面三种权重的乘积。当收到一封邮件的时候，我们需要先对其进行解析，计算其权重，然后对其进行优先级排序。
构造排序函数：

> get_weight <- function(newemail){
+ 
+   from.new.n <- left_join(newemail[,1],from.weight,by = "from")
+   from.new <- ifelse(is.na(from.new.n$freq),1,from.new.n$freq)
+   
+ 
+   if (!is.na(newemail$subject) & str_detect(newemail$subject,"re:")) {
+     newemail$subject <- extract_subject(newemail$subject)
+     subject.new.n <- left_join(newemail,subject.weight,by="subject")
+ 
+     subject.new <- ifelse(is.na(subject.new.n$weight),1,
+                           subject.new.n$weight)
+   } else {
+ 
+     subject.new <- 1
+   }
+   
+ 
+   if (newemail$message!="") {
+ 
+     msg.weight <- str_split(newemail$message," ") %>% unlist %>% 
+       jiebaR::freq() %>% anti_join(stopword,by=c("char"="X1")) %>% 
+       filter(char!="")
+ 
+     if (nrow(msg.weight)!=0) {
+       msg.weight.n <- left_join(msg.weight,term.weight[,c(1,4)],
+                              by=c("char"="term")) %>% 
+         summarise(msg.new=sum(freq*term.weight,na.rm = T))
+       msg.new <- msg.weight.n$msg.new
+     }
+   } else {
+     msg.new <- 1
+   }
+   
+ 
+   return(prod(from.new,subject.new,msg.new))
+ }

5.1 对训练集进行排序

> rank.train <- vector(length = nrow(train))
> for (i in 1:nrow(train)) {
+   rank.train[i] <- get_weight(train[i,])
+ }
> 
> train.rank <- tibble(id=train$id,rank=rank.train)
> 
> summary(train.rank$rank)

##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
##      8.64    282.39    859.82   2300.37   2702.20 241506.57

> # 检查排序值的分布
> p1 <- ggplot(train.rank,aes(rank)) +
+   geom_histogram(bins = 1000, fill = "dodgerblue") +
+   geom_vline(xintercept = median(rank.train),size=1) +
+   xlim(c(0,25000)) +
+   theme_bw() +
+   labs(y="")

6、对测试集进行排序

> rank <- vector(length = nrow(test))
> for (i in 1:nrow(test)) {
+   rank[i] <- get_weight(test[i,])
+ }
> 
> test.rank <- tibble(id=test$id,rank=rank)
> 
> summary(test.rank$rank)

##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##     8.64   237.50   716.02  1913.47  2301.08 36852.14

> # 检查排序值的分布
> p2 <- ggplot(test.rank,aes(rank)) +
+   geom_histogram(bins = 1000, fill = "red") +
+   geom_vline(xintercept = median(rank),size=1) +
+   xlim(c(0,25000)) +
+   theme_bw() +
+   labs(y="")

对比训练集和测试的排序分布。

> p_load(patchwork)
> p1 + p2 + plot_layout(nrow = 2)
训练集和测试集排序值分布

可以看到训练集和测试集的排序分布几乎一模一样，都是长尾分布，意味着更多的邮件的优先级排序不高，这也符合常理。
然后检查一下测试集排序最靠前的20行。

> test[,3] %>% cbind(rank=rank) %>% arrange(-rank) %>% head(20)

##                                                         subject     rank
## 1                                      re: apple sauced...again 36852.14
## 2                                      re: apple sauced...again 36852.14
## 3                           sed /s/united states/roman empire/g 33739.40
## 4                    re: selling wedded bliss (was re: ouch...) 25141.77
## 5                    re: selling wedded bliss (was re: ouch...) 25141.77
## 6                                      re: new sequences window 22509.49
## 7                      [lockergnome windows daily]  fraud wipes 21055.61
## 8                      [lockergnome windows daily]  fraud wipes 21023.90
## 9               [lockergnome windows daily]  brilliant mistakes 21004.60
## 10              [lockergnome penguin shell]  recursive metaphor 20823.06
## 11                    [lockergnome windows daily]  cranky beats 20449.50
## 12 re: comrade communism (was re: crony capitalism (was re: sed 20073.10
## 13                   [lockergnome windows daily]  deeper uplink 20043.92
## 14                                   bush covers the waterfront 19548.67
## 15                   [lockergnome digital media]  clever ritual 19499.38
## 16                   [lockergnome digital media]  clever ritual 19467.67
## 17               [lockergnome windows daily]  dignity shakedown 19325.42
## 18                     [lockergnome penguin shell]  good hearts 19295.45
## 19               [lockergnome windows daily]  dignity shakedown 19293.71
## 20                [lockergnome windows daily]  sticker courtesy 19132.87

主题中几乎有一大半是不活跃的邮件，因为subject中不包含“re:”，也表明排序算法可以将主题之外的其他权重应用到数据中。
尽管这种非监督的排序算法无法测算其准确度，但这结果仍然是很鼓舞人心的。

最后编辑于 ：
©著作权归作者所有,转载或内容合作请联系作者
  • 人面猴
    序言：七十年代末，一起剥皮案震惊了整个滨河市，随后出现的几起案子，更是在滨河造成了极大的恐慌，老刑警刘岩，带你破解...
    沈念sama阅读 158,736评论 4赞 362
  • 死咒
    序言：滨河连续发生了三起死亡事件，死亡现场离奇诡异，居然都是意外死亡，警方通过查阅死者的电脑和手机，发现死者居然都...
    沈念sama阅读 67,167评论 1赞 291
  • 救了他两次的神仙让他今天三更去死
    文/潘晓璐 我一进店门，熙熙楼的掌柜王于贵愁眉苦脸地迎上来，“玉大人，你说我怎么就摊上这事。” “怎么了？”我有些...
    开封第一讲书人阅读 108,442评论 0赞 243
  • 道士缉凶录：失踪的卖姜人
    文/不坏的土叔 我叫张陵，是天一观的道长。 经常有香客问我，道长，这世上最难降的妖魔是什么？ 我笑而不...
    开封第一讲书人阅读 43,902评论 0赞 204
  • 港岛之恋（遗憾婚礼）
    正文 为了忘掉前任，我火速办了婚礼，结果婚礼上，老公的妹妹穿的比我还像新娘。我一直安慰自己，他们只是感情好，可当我...
    茶点故事阅读 52,302评论 3赞 287
  • 恶毒庶女顶嫁案：这布局不是一般人想出来的
    文/花漫 我一把揭开白布。 她就那样静静地躺着，像睡着了一般。 火红的嫁衣衬着肌肤如雪。 梳的纹丝不乱的头发上，一...
    开封第一讲书人阅读 40,573评论 1赞 216
  • 城市分裂传说
    那天，我揣着相机与录音，去河边找鬼。 笑死，一个胖子当着我的面吹牛，可吹牛的内容都是我干的。 我是一名探鬼主播，决...
    沈念sama阅读 31,847评论 2赞 312
  • 双鸳鸯连环套：你想象不到人心有多黑
    文/苍兰香墨 我猛地睁开眼，长吁一口气：“原来是场噩梦啊……” “哼！你这毒妇竟也来了？” 一声冷哼从身侧响起，我...
    开封第一讲书人阅读 30,562评论 0赞 197
  • 万荣杀人案实录
    序言：老挝万荣一对情侣失踪，失踪者是张志新（化名）和其女友刘颖，没想到半个月后，有当地人在树林里发现了一具尸体，经...
    沈念sama阅读 34,260评论 1赞 241
  • 护林员之死
    正文 独居荒郊野岭守林人离奇死亡，尸身上长有42处带血的脓包…… 初始之章·张勋 以下内容为张勋视角 年9月15日...
    茶点故事阅读 30,531评论 2赞 245
  • 白月光启示录
    正文 我和宋清朗相恋三年，在试婚纱的时候发现自己被绿了。 大学时的朋友给我发了我未婚夫和他白月光在一起吃饭的照片。...
    茶点故事阅读 32,021评论 1赞 258
  • 活死人
    序言：一个原本活蹦乱跳的男人离奇死亡，死状恐怖，灵堂内的尸体忽然破棺而出，到底是诈尸还是另有隐情，我是刑警宁泽，带...
    沈念sama阅读 28,367评论 2赞 253
  • 日本核电站爆炸内幕
    正文 年R本政府宣布，位于F岛的核电站，受9级特大地震影响，放射性物质发生泄漏。R本人自食恶果不足惜，却给世界环境...
    茶点故事阅读 33,016评论 3赞 235
  • 男人毒药：我在死后第九天来索命
    文/蒙蒙 一、第九天 我趴在偏房一处隐蔽的房顶上张望。 院中可真热闹，春花似锦、人声如沸。这庄子的主人今日做“春日...
    开封第一讲书人阅读 26,068评论 0赞 8
  • 一桩弑父案，背后竟有这般阴谋
    文/苍兰香墨 我抬头看了看天上的太阳。三九已至，却和暖如春，着一层夹袄步出监牢的瞬间，已是汗流浃背。 一阵脚步声响...
    开封第一讲书人阅读 26,827评论 0赞 194
  • 情欲美人皮
    我被黑心中介骗来泰国打工， 没想到刚下飞机就差点儿被人妖公主榨干…… 1. 我叫王不留，地道东北人。 一个月前我还...
    沈念sama阅读 35,610评论 2赞 274
  • 代替公主和亲
    正文 我出身青楼，却偏偏与公主长得像，于是被迫代替她去往敌国和亲。 传闻我的和亲对象是个残疾皇子，可洞房花烛夜当晚...
    茶点故事阅读 35,514评论 2赞 269