r语言与指标体系建构

定指标
标准化
求权重的三种方法
pca
ahp
熵值

pca 客观 计量 数据有损失
ahp 主观 计数／计量 数据无损失
熵值 客观 计量 数据有损失

重点内容
** pca 王斌会 《多元统计分析及R语言建模》第四版
x1=c(171,175,159,155,152,158,154,164,168,166,159,164)
x2=c(57,64,41,38,35,44,41,51,57,49,47,46)
plot(x1,x2,xlim=c(145,180),ylim=c(25,75))
lines(c(150,178),c(33,66));text(180,68,”y1”)
lines(c(161,168),c(60,38));text(161,63,”y2”)
X=read.table(“clipboard”,header=T) # Àý7.2Êý¾Ý
cor(X)
PCA=princomp(X,cor=T)#Ö÷³É·Ö·ÖÎö
PCA#ÌØÕ÷Öµ¿ª¸ùºÅ½á¹û
options(digits=3)
summary(PCA)
PCA$loadings#Ö÷³É·ÖÔØºÉ par(mar=c(4,4,2,1),cex=0.75) screeplot(PCA,type=”lines”) PCA$scores[,1:2] #Ö÷³É·ÖµÃ·Ö
library(mvstats)
princomp.rank(PCA,m=2)#Ö÷³É·ÖÅÅÃû
princomp.rank(PCA,m=2,plot=T)#Ö÷³É·ÖÅÅÃûÓë×÷ͼ

** ahp 王斌会 《多元统计分析及R语言建模》第四版
library(mvstats)#¼ÓÔØmvstats°ü
A=c(1,3,7,1/3,1,3,1/7,1/3,1)#¹¹ÔìµÄÅжϾØÕó
(A_W=weight(A))#AµÄȨÖØ
CI_CR(A)#Ò»ÖÂÐÔ¼ìÑé
B1data=read.table(“clipboard”,header=T)#Ñ¡È¡Àý13.1ÖÐA-GÁÐÊý¾Ý
B1_z=z_data(B1data)#Êý¾ÝÎÞÁ¿¸Ù»¯z=(x-max)/(max-min)*60+40
B1_z
Si=apply(B1_z,1,mean)#°´ÐÐÇó¾ùÖµ
cbind(B1_z,Si)
cbind(Si=Si,ri,rank(-Si))#°´SiÖµ¸ßµÍÅÅÃû
B1=c(1,4,5,3,6,7,1/4,1,2,1/2,3,4,1/5,1/2,1,1/3,2,3,1/3, 2, 3, 1, 4,5,
1/6,1/3,1/2,1/4,1,2,1/7,1/4,1/3,1/5,1/2,1)#¹¹ÔìB1µÄÅжϾØÕó
B1_W=weight(B1)#B1µÄȨÖØ
B1_W
CI_CR(B1)#Ò»ÖÂÐÔ¼ìÑé
S_rank(B1_Z,B1_W)#°´B1µÃµ½×ۺϵ÷ּ°ÅÅÃû
B2=c(1,4,5,7,8,9,1/4,1,2,4,5,6,1/5,1/2,1,3,4,5,1/7,1/4,1/3,1,2,3,1/8,1/5,
1/4,1/2,1,2,1/9,1/6,1/5,1/3,1/2,1)#¹¹ÔìB2µÄÅжϾØÕó
B2_W=weight(B2)#B2µÄȨÖØ
B2_W
CI_CR(B2)#Ò»ÖÂÐÔ¼ìÑé
B3=c(1,5,2,6,2,6,1,1/5,1,1/4,2,1/4,2,0.2,1/2,5,1,5,1,5,1/2,1/6,1/2,1/5,
1,1/5,1,1/6,1/2,4,1,5,1,5,1/2,1/6,1/2,1/5,1,1/5,1,1/6,1,5,2,2,2,6,1)#¹¹ÔìB3µÄÅжϾØÕó
B3_W=weight(B3)#B3µÄȨÖØ
B3_W
CI_CR(B3)#Ò»ÖÂÐÔ¼ìÑé
data=read.table(“clipboard”,header=T)#Ñ¡È¡Àý13.1Êý¾Ý
x1=data[,1:6]#B1×éÊý¾Ý
x2=data[,7:12]#B2×éÊý¾Ý
x3=data[,13:19]#B3×éÊý¾Ý
S1=S_rank(z_data(x1),B1_W)#°´B1µÃµ½×ۺϵ÷ּ°ÅÅÃû
S2=S_rank(z_data(x2),B2_W)#°´B2µÃµ½×ۺϵ÷ּ°ÅÅÃû
S3=S_rank(z_data(x3),B3_W)#°´B3µÃµ½×ۺϵ÷ּ°ÅÅÃû
S=cbind(S1$Si,S2$Si,S3$Si)#Ðγɵ÷ÖÊý¾Ý
S_rank(S,A_W)#°´AµÃµ½×ۺϵ÷ּ°ÅÅÃû
** 熵值：http://blog.csdn.net/yawei_liu1688/article/details/78745612
第一步：指标的归一化处理（异质指标同质化）:由于各项指标的计量单位并不统一，因此在用他们计算综合指标前，先要进行标准化处理，即把指标的绝对值转化为相对值，从而解决各项不同质指标值的同质化问题。

另外，正向指标和负向指标数值代表的含义不同（正向指标数值越高越好，负向指标数值越低越好），因此，对于正向、负向指标需要采用不同的算法进行数据标准化处理。

正向指标：

这里写图片描述

负向指标：

这里写图片描述

第二步：计算第j项指标下第i个样本值占该指标的比重。

这里写图片描述

第三步：计算第j项指标的熵值。

这里写图片描述

第四步：计算信息熵冗余度（差异）。

这里写图片描述

第五步：计算各项指标的权重。

这里写图片描述

第六步：计算各样本的综合得分。

这里写图片描述

脚本实现
数据读入。

library(forecast)
library(XLConnect)
sourui <- read.csv(“E:/R/operation/train.csv”,header = T)
1
2
3
部分数据展现

这里写图片描述

索引列删除

sourui$案例 <- NULL
1
第一步：归一化处理。

min.max.norm <- function(x){
(x-min(x))/(max(x)-min(x))
}

max.min.norm <- function(x){
(max(x)-x)/(max(x)-min(x))
}

sourui_1 <- apply(sourui[,-c(7,11)],2,min.max.norm) #正向
sourui_2 <- apply(sourui[,c(7,11)],2,max.min.norm) #负向

sourui_t <- cbind(sourui_1,sourui_2)
1
2
3
4
5
6
7
8
9
10
11
12
第二步：求出所有样本对指标Xj的贡献总量

first1 <- function(data)
{
x <- c(data)
for(i in 1:length(data))
x[i] = data[i]/sum(data[])
return(x)
}
dataframe <- apply(sourui_t,2,first1)
1
2
3
4
5
6
7
8
第三步：将上步生成的矩阵每个元素变成每个元素与该ln（元素）的积并计算信息熵。

first2 <- function(data)
{
x <- c(data)
for(i in 1:length(data)){
if(data[i] == 0){
x[i] = 0
}else{
x[i] = data[i] * log(data[i])
}
}
return(x)
}
dataframe1 <- apply(dataframe,2,first2)

k <- 1/log(length(dataframe1[,1]))
d <- -k * colSums(dataframe1)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
第四步：计算冗余度。

d <- 1-d
1
第五步：计算各项指标的权重。

w <- d/sum(d)
w
1
2
最终输出结果展现

这里写图片描述