R语言熵值法确定权重2_r_熵值法_权重_

##R语言熵值法确定权重 library(readxl) library(readxl) data1 <- read_excel("C:/Users/Administrator/Desktop/老梁/熵值法权重0314/data2.xlsx") install.packages("forecast") library(forecast) install.packages("XLConnect") library(XLConnect) sourui <- data1 ##sourui$案例 <- NULL #去掉字符型变量 #第一步：归一化处理 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(5,6,9,10,11,12,13,14,19)],2,min.max.norm) #正向 sourui_2 <- apply(sourui[,c(5,6,9,10,11,12,13,14,19)],2,max.min.norm) #负向 sourui_t <- cbind(sourui_1,sourui_2) #第二步：求出所有样本对指标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) #第三步：将上步生成的矩阵每个元素变成每个元素与该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) #第四步：计算冗余度 d <- 1-d #第五步：计算各项指标的权重 w <- d/sum(d) w w1 <- as.data.frame(w) w1 dataframe0 <- as.data.frame(dataframe) sourui$总评分 <- dataframe0$x1 * w1[1,] + dataframe0$x2 * w1[2,] + dataframe0$x3 * w1[3,]+ dataframe0$x4 * w1[4,] + dataframe0$x5 * w1[5,] + dataframe0$x6 * w1[6,] + dataframe0$x7 * w1[7,] + dataframe0$x8 * w1[8,] + dataframe0$x9 * w1[9,] + dataframe0$x10 * w1[10,] + dataframe0$x11 * w1[11,] + dataframe0$x12 * w1[12,] + dataframe0$x13 * w1[13,]+ dataframe0$x14 * w1[14,]+ dataframe0$x15 * w1[15,]+ dataframe0$x16 * w1[16,]+dataframe0$x17 * w1[17,]+dataframe0$x18 * w1[18,]+ dataframe0$x19 * w1[19,]+dataframe0$x20 * w1[20,]+dataframe0$x21 * w1[21,]+ dataframe0$x22 * w1[22,] sourui$绿色环境竞争力 <- dataframe0$x1 * w1[1,] + dataframe0$x2 * w1[2,] + dataframe0$x3 * w1[3,]+ dataframe0$x4 * w1[4,]+ dataframe0$x5 * w1[5,]+ dataframe0$x6 * w1[6,]+ dataframe0$x7 * w1[7,] sourui$绿色可持续竞争力 <- dataframe0$x8 * w1[8,] + dataframe0$x9 * w1[9,] + dataframe0$x10 * w1[10,]+ dataframe0$x11 * w1[11,]+ dataframe0$x12 * w1[12,]+ dataframe0$x13 * w1[13,]+ dataframe0$x14 * w1[14,] sourui$绿色供给竞争力<-dataframe0$x15 * w1[15,] + dataframe0$x16 * w1[16,]+ dataframe0$x17 * w1[17,]+ dataframe0$x18 * w1[18,] sourui$绿色经济竞争力<-dataframe0$x19 * w1[19,] + dataframe0$x20 * w1[20,]+ dataframe0$x21 * w1[21,]+ dataframe0$x22 * w1[22,] sourui$id=c("2013","2014","2015","2016","2017","2018") plot(sourui$id,sourui$绿色环境竞争力,xlab="年份",ylab="得分",type="b",pch=22) lines(sourui$id,sourui$绿色可持续竞争力,xlab="年份",ylab="得分",type="b",pch=16) lines(sourui$id,sourui$绿色供给竞争力,xlab="年份",ylab="得分",type="b",pch=14) lines(sourui$id,sourui$绿色经济竞争力,xlab="年份",ylab="得分",type="b",pch=12) lines(sourui$id,sourui$总评分,xlab="年份",ylab="得分",type="b",pch=18) plot(sourui$id,sourui$绿色可持续竞争力,xlab="年份",ylab="得分",type="b") plot(sourui$id,sourui$绿色供给竞争力,xlab="年份",ylab="得分",type="b") plot(sourui$id,sourui$绿色经济竞争力,xlab="年份",ylab="得分",type="b") plot(sourui$id,sourui$总评分,xlab="年份",ylab="得分",type="b") library(xlsx) write.table(sourui,"C:/Users/Administrator/Desktop/老梁/熵值法权重0314/sourui2.csv",sep=",") write.table(sourui_t,"C:/Users/Administrator/Desktop/层次分析2000/souruit.csv",sep=",")