什么R代码来计算每个级别的熵在一个分类变量

Question

我的数据集中有相当多的分类变量，这些变量每个都有两个以上的级别。现在我想要一个R代码函数(或循环)，可以计算每个分类变量中每个级别的熵和信息增益，并返回最低熵和最高信息增益。

data <- list(buys = c("no", "no", "yes", "yes", "yes", "no", "yes", "no", "yes", "yes", "yes", "yes", "yes", "no"),credit = c("fair", "excellent", "fair", "fair", "fair", "excellent", "excellent", "fair", "fair", "fair", "excellent", "excellent", "fair", "excellent"),student = c("no", "no", "no","no", "yes", "yes", "yes", "no", "yes", "yes", "yes", "no", "yes", "no"),income = c("high", "high", "high", "medium", "low", "low", "low", "medium", "low", "medium", "medium", "medium", "high", "medium"),age = c(25, 27, 35, 41, 48, 42, 36, 29, 26, 45, 23, 33, 37, 44))
data<- as.data.frame(data)

上面是一个示例数据框架

entropy_tab <- function(x) { tabfun2 <- prop.table(table(data[,x],training_credit_Risk[,13]) + 1e-6, margin = 1)sum(prop.table(table(data[,x]))*rowSums(-tabfun2*log2(tabfun2)))}

上面的函数计算每个变量的熵，我想要一个函数来计算每个级别对熵的贡献?即"优秀"的贡献;和";fair"到"信用"熵

Answer 1

在测度理论中，具有测度mu的测度空间中事件A的期望惊奇度为

-mu(A)log(mu(A))

所以熵是所有事件的期望惊奇度之和。因此，您要寻找的是每个变量的每个水平的预期惊讶度。

请注意，您将无法将数据帧的惊喜表示为数据帧，因为数据帧中的每个变量都具有不同数量的级别。

你可以做

exp_surprisal <- function(x, base=exp(1)) {
t <- table(x)
freq <- t/sum(t)
ifelse(freq==0, 0, -freq * log(freq, base))
}

和

lapply(data, exp_surprisal)

为

$buys
x
no       yes 
0.3677212 0.2840353 
$credit
x
excellent      fair 
0.3631277 0.3197805 
$student
x
no       yes 
0.3465736 0.3465736 
$income
x
high       low    medium 
0.3579323 0.3579323 0.3631277 
$age
x
23        25        26        27        29        33        35        36        37        41        42        44        45        48 
0.1885041 0.1885041 0.1885041 0.1885041 0.1885041 0.1885041 0.1885041 0.1885041 0.1885041 0.1885041 0.1885041 0.1885041 0.1885041 0.1885041 

注意你也可以定义

entropy <- function(x) sum(exp_surprisal(x))

得到熵

然后

lapply(data, entropy)

为

$buys
[1] 0.6517566
$credit
[1] 0.6829081
$student
[1] 0.6931472
$income
[1] 1.078992
$age
[1] 2.639057

Answer 2

您必须修改您的函数以具有两个输入，您想要的变量和变量的级别。然后，在函数内部，您必须根据所需变量的级别进行子集划分。然后，我使用mapply循环遍历变量credit及其每个级别。

entropy_tab <- function(x,y) { 
tabfun2 <- prop.table(table(data[,x][data[,x] == y] ,data[,5][data[,x]==y]) + 1e-6, margin = 1)
sum(prop.table(table(data[,x][data[,x] == y]))*rowSums(-tabfun2*log2(tabfun2)))
}

x <- mapply(entropy_tab, c("credit","credit"), unique(data$credit))
names(x) <- unique(data$credit)
#checks
entropy_tab("credit","excellent")
entropy_tab("credit","fair")