教育统计中的常见问题(三)

相关关系问题(积差相关、斯皮尔曼相关、肯德尔相关)
  • 积差相关,又称为皮尔逊相关。使用要求:成对数据,等距或等比性质的两连续变量,正态分布,样本数量大于30。例如每个学生的智力和学习成绩,每个人的身高和体重等。任意两个个体之间不能求皮尔逊相关。
  • 斯皮尔曼等级相关。积差相关的延申,精度小于积差相关。使用要求:成对数据,等距或等比性质的两连续变量,数据分布无要求,样本数可小于30。
  • 肯德尔等级相关。用字母$W$表示,又称为肯德尔和谐系数,功用与斯皮尔曼等级相关相同,适合于两列以上的等级变量。

一、积差相关

$$r = \frac {\sum xy}{Ns_Xs_Y}$$
式中:
$x,y$为两变量离均差, $x = X – \overline X$ $Y = Y- \overline Y$
$N$为成对数据的数目,
$s_X$为$X$变量的标准差, $s_Y$为$Y$变量的标准差

例1:两学科成绩相关性(皮尔逊相关)

某班50名学生学生某次测验成绩如下,问两科目成绩是否具有一致性。

set.seed(1) 
x <- round(runif(50,40,100))
set.seed(2) 
y <- round(runif(50,40,100))

N <- 50
m_x <- x - mean(x)
m_y <- y - mean(y)
sx <- sd(x)
sy <- sd(y)
r1 <- sum(m_x*m_y)/(N*sx*sy) # 0.146

# cor()直接计算
r2 <-cor(x,y,method = "pearson") # 0.149

二、斯皮尔曼等级相关

$$r_R =1- \frac {6{\sum D^2}}{N(N^2-1)}$$
式中:
$N$为等级个数, $D$指二列成对变量的等级差数 。

例1:两学科成绩相关性(斯皮尔曼相关)

某班10名学生某次测验成绩如下,问两科目成绩是否具有一致性。

set.seed(1) 
x <- round(runif(10,40,100))
set.seed(2) 
y <- round(runif(10,40,100))

N <- 10
D <- rank(x)-rank(y)
r1 <- 1-(6*sum(D^2))/(N*(N^2-1))   # -0.281

# cor()直接计算
r2 <- cor(x,y,method = "spearman")  # -0.289

例2:视听反映是否一致

N <- 10
x <- c(172,140,152,187,139,195,212,164,149,146)
y <- c(179,162,153,189,181,220,210,182,178,170)

D <- rank(x)-rank(y)
r1 <- 1-(6*sum(D^2))/(N*(N^2-1))   # 0.7090909

# cor()直接计算
r2 <- cor(x,y,method = "spearman")  # 0.7090909

三、肯德尔等级相关

同一评价者无相同等级评定时,W的计算公式:
$$W = \frac {s}{ \frac {1}{12}K^2(N^3-N)}$$
式中:
$s=\sum(R_i-\frac{\sum R_i}{N})^2$;
$R_i代$表评价对象获得的K个等级之和;
$K$代表等级评定者数;
$N$代表被等级评定的对象数目。

同一评价者有相同等级评定时,W的计算公式:
$$W = \frac {s}{ \frac {1}{12}K^2(N^3-N)-K \sum T}$$
其中:
$\sum T = \sum\frac{n_{ij}^3-n_{ij}}{12}$,$n_{ij}$为第$i$个评价者的评定结果中第$j$个重复等级的相同等级数。

$W$介于0到1之间,W=1表示K个评价者意见完全一致,0<W<1代表K个评价者意见存在一定关系,但不完全一致,W=0表示K个评价者意见完全不一致。

例1:作文评分标准掌握是否一致

data <- data.frame(K1 = c(4,1,2.5,6,2.5,5,7),
                   K2 = c(5,1,2,5,3,5,7),
                   K3 = c(3.5,1.5,1.5,5,3.5,7,6),
                   K4 = c(5,2,2,4,2,6,7),
                   K5 = c(4,1,2,5,3,6,7)
                   )
rownames(data) <- LETTERS[1:7]
N <- 7
K <- 5

R_i <- rowSums(sapply(data, rank))
s <- sum( (R_i-sum(R_i)/N)^2 )

# T_ij计算
T_ij <- function(x){

  tmp <- table(x)
  n <- tmp[tmp >= 2]
  T_ij <- (n^3-n)/12

  return(as.numeric(T_ij))
}
T_ij_sum <- sum(unlist(sapply(data,T_ij))) # 5.5

W <- s/(K^2*(N^3-N)/12-K*T_ij_sum) # 0.9256
 # 五位评分这对七篇作文的评价标准比较一致

例2:对颜色喜爱程度是否一致

假设有10人对7种颜色的喜爱程度进行评级,最喜欢为7,最不喜欢为1,结果如下表,问这10人对颜色的爱好是否一致。

# 下数据模拟10人对"红","橙","黄"喜爱程度一致,计算W结果为0.84
set.seed(1)
data <- data.frame(K1 = c(7,6,5,sample(1:4,4)),
                   K2 = c(7,6,5,sample(1:4,4)),
                   K3 = c(7,6,5,sample(1:4,4)),
                   K4 = c(7,6,5,sample(1:4,4)),
                   K5 = c(7,6,5,sample(1:4,4)),
                   K6 = c(7,6,5,sample(1:4,4)),
                   K7 = c(7,6,5,sample(1:4,4)),
                   K8 = c(7,6,5,sample(1:4,4)),
                   K9 = c(7,6,5,sample(1:4,4)),
                   K10 = c(7,6,5,sample(1:4,4))
)
rownames(data) <- c("红","橙","黄","绿","蓝","青","紫")

# 下数据模拟10人对所有颜色喜爱程度一致,计算W结果为1
# data <- data.frame(K1 = 7:1,
#                    K2 = 7:1,
#                    K3 = 7:1,
#                    K4 = 7:1,
#                    K5 = 7:1,
#                    K6 = 7:1,
#                    K7 = 7:1,
#                    K8 = 7:1,
#                    K9 = 7:1,
#                    K10 = 7:1
# )
# 
# rownames(data) <- c("红","橙","黄","绿","蓝","青","紫")

N <- 7
K <- 10

R_i <- rowSums(sapply(data, rank))
s <- sum( (R_i-sum(R_i)/N)^2 )

# T_ij计算计算
T_ij <- function(x){

  tmp <- table(x)
  n <- tmp[tmp >= 2]
  T_ij <- (n^3-n)/12

  return(as.numeric(T_ij))
}
T_ij_sum <- sum(unlist(sapply(data,T_ij))) # 结果为0 (同一评价者无相同等级评定)

W <- s/(K^2*(N^3-N)/12-K*T_ij_sum) # 0.84
 # 从W值看,这10个人对颜色喜爱具有较高一致性

留下评论