b<-a[which(a[,4]-a[,3]>1000000),]
时间: 2024-01-05 13:03:33 浏览: 21
This code selects all rows from the data frame "a" where the difference between the values in the fourth and third column is greater than 1,000,000. The selected rows are then assigned to a new data frame called "b".
相关问题
#------(一)方法1:基于指标体系1的结果---- #--------1.数据导入------------- library(xlsx) d1.1 <- read.xlsx('data.xlsx', '2022', encoding = "UTF-8") #读取数据 head(d1.1,10) colnames(d1.1) d1 <- d1.1[,5:ncol(d1.1)] d1 <- abs(d1) #---------2.归一化处理--------------- Rescale = function(x, type=1) { # type=1正向指标, type=2负向指标 rng = range(x, na.rm = TRUE) if (type == 1) { (x - rng[1]) / (rng[2] - rng[1]) } else { (rng[2] - x) / (rng[2] - rng[1]) } } #---------3.熵值法步骤---------- #定义熵值函数 Entropy = function(x) { entropy=array(data = NA, dim = ncol(x),dimnames = NULL) j=1 while (j<=ncol(x)) { value=0 i=1 while (i<=nrow(x)) { if (x[i,j]==0) { (value=value) } else { (value=value+x[i,j]log(x[i,j])) } i=i+1 } entropy[j]=value(-1/log(nrow(x))) j=j+1 } return(entropy) } Entropy_Weight = function(X, index) { pos = which(index == 1) neg = which(index != 1) X[,pos] = lapply(X[,pos], Rescale, type=1) X[,neg] = lapply(X[,neg], Rescale, type=2) P = data.frame(lapply(X, function(x) x / sum(x))) e = Entropy(P) d = 1 - e # 计算信息熵冗余度 w = d / sum(d) # 计算权重向量 list(X = X,P = P, w=w) } #-------4.代入数据计算权重----- # -------二级指标权重------ ind=array(rep(1,ncol(d1))) aa=Entropy_Weight(X = d1,index = ind) weight=as.data.frame(aa["w"]) weigh X <- as.data.frame(aa["X"]) X P <- as.data.frame(aa["P"]) P d1.a <- X[,c(grep("A",colnames(X)))] d1.b <- X[,c(grep("B",colnames(X)))] d1.c <- X[,c(grep("C",colnames(X)))] d1a <- as.matrix(d1.a) d1b <- as.matrix(d1.b) d1c <- as.matrix(d1.c) n1 <- ncol(d1a) n2 <- ncol(d1b) n3 <- ncol(d1c) wa <- weight[1:n1,1] wb <- weight[(n1+1):(n1+n2),1] wc <- weight[(n1+n2+1):(n1+n2+n3),1] wa <- as.matrix(wa,ncol =1) wb <- as.matrix(wb,ncol =1) wc <- as.matrix(wc,ncol =1) indexa <- d1a%%wa indexb <- d1b%%wb indexc <- d1c%*%wc d1abc <- cbind(indexa,indexb,indexc) 参考以上代码,用不同一级指标下分别计算二级指标权重,再求一级指标权重
好的,根据你的要求,我会根据以上代码,对不同一级指标下分别计算二级指标权重,并求一级指标权重。
首先,我们需要导入数据并进行数据预处理,包括归一化处理等。然后,我们需要定义熵值函数和熵权法函数,最后代入数据计算权重。
以下为代码实现:
#-------1.数据导入-------------
library(xlsx)
d1.1 <- read.xlsx('data.xlsx', '2022', encoding = "UTF-8") #读取数据
head(d1.1,10)
colnames(d1.1)
d1 <- d1.1[,5:ncol(d1.1)]
d1 <- abs(d1)
#-------2.归一化处理---------------
Rescale = function(x, type=1) {
# type=1正向指标, type=2负向指标
rng = range(x, na.rm = TRUE)
if (type == 1) {
(x - rng[1]) / (rng[2] - rng[1])
} else {
(rng[2] - x) / (rng[2] - rng[1])
}
}
#-------3.熵值法步骤----------
#定义熵值函数
Entropy = function(x) {
entropy=array(data = NA, dim = ncol(x),dimnames = NULL)
j=1
while (j<=ncol(x)) {
value=0
i=1
while (i<=nrow(x)) {
if (x[i,j]==0) {
(value=value)
} else {
(value=value+x[i,j]log(x[i,j]))
}
i=i+1
}
entropy[j]=value(-1/log(nrow(x)))
j=j+1
}
return(entropy)
}
#定义熵权法函数
Entropy_Weight = function(X, index) {
pos = which(index == 1)
neg = which(index != 1)
X[,pos] = lapply(X[,pos], Rescale, type=1)
X[,neg] = lapply(X[,neg], Rescale, type=2)
P = data.frame(lapply(X, function(x) x / sum(x)))
e = Entropy(P)
d = 1 - e # 计算信息熵冗余度
w = d / sum(d) # 计算权重向量
list(X = X,P = P, w=w)
}
#-------4.代入数据计算权重-----
# -------一级指标权重------
ind1=array(c(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1))
aa1=Entropy_Weight(X = d1,index = ind1)
weight1=as.data.frame(aa1["w"])
weight1
# -------二级指标权重------
d1a <- d1[,c(1:6)]
d1b <- d1[,c(7:12)]
d1c <- d1[,c(13:18)]
#一级指标A下的二级指标权重
ind2a=array(c(1,1,1,1,1,1))
aa2a=Entropy_Weight(X = d1a,index = ind2a)
weight2a=as.data.frame(aa2a["w"])
weight2a
#一级指标B下的二级指标权重
ind2b=array(c(1,1,1,1,1,1))
aa2b=Entropy_Weight(X = d1b,index = ind2b)
weight2b=as.data.frame(aa2b["w"])
weight2b
#一级指标C下的二级指标权重
ind2c=array(c(1,1,1,1,1,1))
aa2c=Entropy_Weight(X = d1c,index = ind2c)
weight2c=as.data.frame(aa2c["w"])
weight2c
#计算一级指标权重
w1a <- weight2a[1:6,1]
w1b <- weight2b[1:6,1]
w1c <- weight2c[1:6,1]
w1a <- as.matrix(w1a,ncol =1)
w1b <- as.matrix(w1b,ncol =1)
w1c <- as.matrix(w1c,ncol =1)
indexa <- d1a%*%w1a
indexb <- d1b%*%w1b
indexc <- d1c%*%w1c
d1abc <- cbind(indexa,indexb,indexc)
ind1abc=array(c(1,1,1))
aa1abc=Entropy_Weight(X = d1abc,index = ind1abc)
weight1abc=as.data.frame(aa1abc["w"])
weight1abc
distance_discrimination <- function(train_data, train_group, new_data) { n_train <- nrow(train_data) n_features <- ncol(train_data) group_levels <- unique(train_group) n_groups <- length(group_levels) means <- matrix(0, n_groups, n_features) # 计算各组的均值 for (i in 1:n_groups) { means[i,] <- colMeans(train_data[train_group == group_levels[i],]) } # 计算各组的协方差矩阵 covs <- list() for (i in 1:n_groups) { covs[[i]] <- cov(train_data[train_group == group_levels[i],]) } # 计算马氏距离 distances <- matrix(0, nrow(new_data), n_groups) for (i in 1:n_groups) { distances[,i] <- mahalanobis(new_data, means[i,], covs[[i]]) } # 返回分类结果 group_levels[apply(distances, 1, which.min)] } #数据两组数据,两个属性x,y,标签为"A","B" x1 <- c(1, 2, 3, 4, 5) y1 <- c(1, 2, 1, 2, 1) x2 <- c(10, 11, 12, 13, 14) y2 <- c(10, 9, 10, 9, 10) train_data <- rbind(cbind(x1, y1), cbind(x2, y2)) train_group <- c("A","A","A","A","A","B","B","B","B","B") new_data <- cbind(c(3, 5, 11, 13), c(1, 1, 9, 10)) # 使用距离判别函数进行分类 distance_discrimination(train_data, train_group, new_data)解释一下代码
这段代码实现了一个基于马氏距离的距离判别函数,用于对新数据进行分类。具体实现过程如下:
1. 读入训练数据 train_data,训练数据标签 train_group,以及新数据 new_data。
2. 计算训练数据中每个标签组的均值和协方差矩阵。
3. 对于新数据 new_data,分别计算其到每个标签组的马氏距离。
4. 返回距离最小的标签组作为分类结果。
其中,计算马氏距离需要用到每个标签组的均值和协方差矩阵,这些信息可以通过训练数据 train_data 和 train_group 计算得到。距离判别函数的核心就是计算马氏距离,这个距离考虑了各个属性之间的相关性,因此比欧式距离更具有区分性。
在这个例子中,训练数据中有两个标签组,分别为"A"和"B",每个标签组有两个属性 "x" 和 "y"。新数据包含了四个样本,分别为 (3, 1), (5, 1), (11, 9), (13, 10),程序运行后将会输出对应的分类结果。