从一份四级成绩单开始的推理......

偶然的机会，小编我得到了一份数据：某高校的四级考试成绩册。

数据是哪个时期的？哪所高校的？

我也不知道，不过真相就在推理之后。

不要走神，让我们现在从一份数据出发，开始咱们的统计推理之旅......

准备工作

既然我们要对一组新数据进行分析，首先就要运行一条命令，清空之前储存的变量空间。

rm(list = ls())

这主要是为了清除一些迭代控制变量，防止之前数据分析产生的变量重复使用在这次数据分析过程中，造成不良后果。

接下来要准备几个用来分析数据的R包。

library(readxl)
library(tidyverse)
library(fBasics)
library(igraph)
library(ggplot2)

• readxl，用以读取数据，方便大家自由查看数据集，不了解这个包的小伙伴可以通过文末链接查看之前一篇关于数据读取的小文章哦。

• tidyverse，是一整套处理数据的R包集，而不只是一个小package，十分实用，强烈推荐给大家！

• fBasics，用来进行数据探索性分析，研究分布特性研究，包括参数估计和假设检验。此外，还有一些用于数据处理和管理的实用功能。

• igraph，用于社交网络数据的分析和可视化，这里我们只是借助于里面的一个小函数对幂律分布进行检验。

• ggplot2，用来画图。

初识数据

#读入数据
Data_score = readxl::read_xlsx("四级成绩数据.xlsx",sheet = 1)
summary(Data_score)

我们先来看看这份数据。

   学生姓名             学号               年级               班级          
 Length:5564        Length:5564        Length:5564        Length:5564       
 Class :character   Class :character   Class :character   Class :character  
 Mode  :character   Mode  :character   Mode  :character   Mode  :character                    
  笔试成绩总分  
 Min.   :  0.0  
 1st Qu.:345.0  
 Median :386.0  
 Mean   :359.1  
 3rd Qu.:423.0  
 Max.   :613.0  

数据集中一共包含5564名学生，五个变量：学生姓名、学号、年级、班级、笔试成绩总分。

学生笔试成绩中最小值为0分。

CET4 = Data_score$笔试成绩总分
length(which(CET4 == 0))
[1] 474

我们发现交白卷的同学并且高达474人，这是怎么回事，是因为任何题都不会吗？

自然不是。根据监考经验，每个考场很大概率上是有缺考同学的，也就是报了个名，但没有去考试，毕竟每年两次考试机会，这次没去，下次准备好了就可以补上。

为了便于分析，我们把这一部分成绩为零的样本剔除掉。

Data_nonzero = Data_score[CET4 >0,]
n = nrow(Data_nonzero)

我们知道，成绩一般服从的是正态分布，那么不妨一起来看看。

hist(Data_nonzero$笔试成绩总分, breaks = 100, probability=T, col="pink")
lines(density(Data_nonzero$笔试成绩总分), col="blue", lwd=2)

没错，恰好呈现一个中间高、两头低的钟形曲线的样子。

再来看看，成绩的均值和标准差。

mean(Data_nonzero$笔试成绩总分)
[1] 392.5866
sd(Data_nonzero$笔试成绩总分)
[1] 51.65606

均值近似为为393，标准差近似为51.7，从这里有什么发现？

上一期我们说过，教育部是通过正态分布 计算各位考生的成绩的。

此高校的均值比500少了将近110分，可以推断，这所学校一定不是“16所高校”之一。

年级信息

下面我们具体看一下考生的年级情况。

factor(Data_nonzero$年级)

结果显示:

Levels: 17 18 19 20

也就是说，这里包含的的学生来自2017、2018、2019、2020级的。既然有2020级的，该年级的学生9月份入学，那肯定就是2020年12月12日那次考试的结果。

之所以，记得这次考试的确切时间，是因为那一天我有监考任务，还是主监考，但却在12月11日熬到凌晨抢双十二的货。

在这里，我们还能获得一个信息，20级是大一新生，却有参加四级考试的机会，这在高校很少见，既然不是中国头部院校，那应该就是具有外语特色的院校。

再来看一看不同年级的四级成绩情况。

Grade_score = Data_nonzero %>% group_by(`年级`) %>% 
summarise(num = n(),
          mean_score = mean(`笔试成绩总分`),
          median_score = median(`笔试成绩总分`),
          sd_score = sd(`笔试成绩总分`),
          quantile_score = IQR(`笔试成绩总分`),
          ) %>% 
          arrange(desc(`年级`))
          
# A tibble: 4 x 6
  年级    num mean_score median_score sd_score quantile_score
  <chr> <int>      <dbl>        <dbl>    <dbl>          <dbl>
1 20     1470       417.          418     54.4           70  
2 19     1675       385.          386     48.7           67.5
3 18     1030       381.          384     43.7           58.8
4 17      915       379.          378     46.6           62  

从均值和中位数来看，四个年级的成绩呈现逐渐提高的趋势。

大一新生四级成绩均值为417分，大二385分，大三381分，到了大四就已经是379了。

初步判断，大学刚入学的时候，由于高中应试教育，大家的英语水平还不错，将近一半的同学通过四级。

已经通过英语的同学自然不用再参加考试了，但是没有通过的同学，可能随着年级的升高，专注于享受美好的大学生活，英语水平嘛，自然就不可说不可说了......

所以大二到大四年级的同学，四级成绩均值相近。

但是，从统计上来说，是不是这样子呢？我刚才的推断是正确的吗？

通过箱线图，可以看出不同年级的波动情况不同。

要想知道该校各年级四级考生成绩是否有显著性差异，还得进行个两两比较。

下面，我们做一下显著性检验。

sig_pair <- aov(`笔试成绩总分` ~ `年级`, Data_nonzero)

TukeyHSD(sig_pair)

Tukey multiple comparisons of means
    95% family-wise confidence level

Fit: aov(formula = 笔试成绩总分 ~ 年级, data = Data_nonzero)

$年级
           diff       lwr       upr     p adj
18-17  2.894541 -2.840213  8.629295 0.5647874
19-17  6.617010  1.427623 11.806397 0.0058232
20-17 38.873347 33.557663 44.189030 0.0000000
19-18  3.722469 -1.276055  8.720993 0.2222592
20-18 35.978806 30.849284 41.108328 0.0000000
20-19 32.256337 27.744759 36.767914 0.0000000

从检验 -值可以看出，其他各年级与20级考生相比，平均成绩有显著差异，但是分别对17级与18级、18级与19级的考生成绩进行检验的时候，却不能拒绝无显著差异的原假设。

这恰好验证了我之前的推断：该校20级新生的四级考试成绩最好，19-18、18-17两两比较，无显著差异。

专业信息

接下来，我们通过这份数据看看这个学校的学科专业情况。

通过考生所在班级，提取专业信息，按照参加考试的人数进行专业排序。

Major_score = Data_score %>%  mutate( `专业` = str_extract(Data_score$`班级`,"[\u4e00-\u9fa5]{0,}")) %>% 
           group_by(`专业`) %>%
           summarise(num = n(),
           mean_score = mean(`笔试成绩总分`),
           median_score = median(`笔试成绩总分`),
           sd_score = sd(`笔试成绩总分`),
           quantile_score = IQR(`笔试成绩总分`),
           ) %>% 
           arrange(desc(`num`))
           
head(major_score)
# A tibble: 6 x 5
  专业           num mean_score median_score quantile_score
  <chr>        <int>      <dbl>        <dbl>    <dbl>
1 会计学         640       351.          381     71.2
2 财务管理       405       347.          381     78  
3 英语           378       414.          424     68.5
4 金融学         323       353.          387     73.5
5 广播电视编导   271       334.          363     74  

注意，这一次我们所用的数据是全体报考同学的。

考生越多的专业，一般代表该校对这个专业越重视，计划招生人数多。

可以看出，该校会计学、财务管理学、英语、金融学、广播电视编导当属考生最多的前五大专业。

具体看一下，我们从这份数据中提出的专业类型.

unique(major_score$专业)

 [1] "会计学"               "财务管理"             "英语"                
 [4] "金融学"               "广播电视编导"         "审计学"              
 [7] "物流管理"             "国际经济与贸易"       "市场营销"            
[10] "工程造价"             "学前教育"             "金融工程"            
[13] "信息管理与信息系统"   "工程管理"             "法语"                
[16] "资产评估"             "经济统计学"           "日语"                
[19] "投资学"               "电子商务"             "翻译"                
[22] "土木工程"             "小学教育"             "广编"                
[25] "动画"                 "环境设计"             "西班牙语"            
[28] "服装与服饰设计"       "国贸"                 "大数据"              
[31] "产品设计"             "视觉传达设计"         "数据科学与大数据技术"
[34] "大数据管理与应用"     "数媒艺术"             "智能建造"            
[37] "美术学"               "建筑工程实验班"         "现代信息技术"        
[40] "视觉传达"             "智慧金融实验班"       "油画实验班"          
[43] "数字媒体艺术"         "现代商贸服务业创新"   "国际化视野精英班"    
[46] "感性设计"             "学期教育"             "影视编导"   

计数是48个，但由于里面有一些学生来自实验班，这些实验班可能也归属于某一专业。所以推断该校实际专业个数应该是40左右。

我们再查看一下考生人数最少的几个班级或专业。

n_major <- nrow(Major_score)
Major_score[(n_major-14):n_major,]
# A tibble: 15 x 5
   专业                 num mean_score median_score quantile_score
   <chr>              <int>      <dbl>        <dbl>          <dbl>
 1 大数据管理与应用      27       396.         389            60  
 2 数媒艺术              22       318.         349            81  
 3 智能建造              21       416.         425            58  
 4 美术学                16       214.         301           352. 
 5 建筑工程实验班          13       258.         332           366  
 6 现代信息技术          13       348.         362            47  
 7 视觉传达               9       352.         340            37  
 8 智慧金融实验班         8       406.         414            56.2
 9 油画实验班             5       291.         358            44  
10 数字媒体艺术           4       398.         390.           42.2
11 现代商贸服务业创新     3       254.         352           206. 
12 国际化视野精英班       2       448.         448.            1.5
13 感性设计               1       358          358             0  
14 学期教育               1       350          350             0  
15 影视编导               1         0            0             0  

国际化视野精英班和智慧金融实验班参加考试的学生都小于十人，但平均成绩高达400分以上，说明这两个实验班所招学生的确是该校精英学生。

油画实验班和建筑工程实验班的成绩的平均成绩只有200多分，可见这两个班应该招的是艺术生，文化分不高。

由于有缺考学生，为了减少这些极端值的影响，我们采用中位数对专业进行排序。

可以发现，排名靠前的二十个专业中，外类和经贸类专业很多。

根据这一小节的分析，可以推断该校一共有40个左右的专业，外语类和经贸类为该校重点发展的专业类型。

姓氏信息

之所以来提取姓氏信息，是为了圈定这所高校的所在地。

一般高校都有一定的区域性。根据之前我们的推断：该高校不是国内头部大学，估摸也就能吸引到附近几个省区的学生，更糟糕的话，甚至只能吸引到省内学生。

而每一个地区，都有一些古代豪强大户，这些大户会明显影响一个地区的姓氏频率。

下面我们就一起来看一下这里面藏了什么秘密。

> surname =  str_sub(Data_score$学生姓名,1,1)
freq_surname = table(surname)
freq_surname_dec = freq_surname[order(freq_surname,decreasing = TRUE)]
freq_surname_dec[freq_surname_dec>70]
# 运行结果
surname
 陈  林  黄  王  张  李  吴  刘  杨  郑  蔡  许  周 
607 472 318 304 294 284 225 167 140 129  89  85  72 

可以看出陈氏学生人数最多，不妨画个图瞅瞅。

plot(freq_surname_dec,xlab = "姓氏",ylab = "频数",main = "姓氏频数分布图")

有啥感觉？貌似服从幂律分布是不是？

power_law = fit_power_law(freq_surname_dec)
power_law
# 结果
continuous  alpha   xmin   logLik   KS.stat   KS.p
FALSE  1.993319  17 -293.8556 0.05656355 0.9898004

没错，一般情况下，姓氏的确服从幂律分布，我们的检验 值也说明了同样一件事儿： 值远大于显著性水平0.05，无法拒绝原假设幂律分布的假设。

特别提取出考生人数大于70的几个姓氏。

plot(freq_surname_dec[freq_surname_dec>70],xlab = "姓氏",ylab = "频数",main = "姓氏频数大于70的分布图")

“陈”是全国第五大姓氏，而且也是浙江、广州、福建三省人口最多的姓氏。

“林”主要分布在福建、广东两省，大约占林姓总人口的55%。据说在福建，每六个人中就有一个是姓林的。

“黄”最集中的分布省份是江西和福建，这两省的黄姓大约占全国黄姓总人口的53.5%。

初步推断这所高校可能位于福建地区。等看到后面紧跟的的“郑”和“蔡”，就能更加确定了。

于是，我们推断：该高校应该是福建省的一所重点发展外语、金融贸易的特色院校。

锁定目标

接下来激动人心的时刻到了！

首先利用我们之前的推断，在百度搜索“福建 财经类 大学”，在中国教育在线网站列出四所高校：

其中具有外语特色的只有福州外语外贸学院。

我们找到这所学校的主页，打开学校简介：

往下翻看，找到介绍专业的部分：

大家发现什么？

是不是和我们之前获取的专业信息一致？

是的，真相只有一个!

这个数据是来自于福州外语外贸学院的！

各位小伙伴，有没有觉得很有意思，你也可以试着用你获取的信息进行一系列推理哦，也许会有一个意想不到的结果出现！