ID3决策树（R实现）

说明

1.参考文章：R语言实现决策树ID3算法
2.补充了分类预测的函数部分
3.采用数据框模拟xml文件的方式存储决策树

代码

训练集（train_data）

outlook	temperature	humidity	windy	play
sunny	hot	high	FALSE	no
sunny	hot	high	TRUE	no
overcast	hot	high	FALSE	yes
rainy	mild	high	FALSE	yes
rainy	cool	normal	FALSE	yes
rainy	cool	normal	TRUE	no
overcast	cool	normal	TRUE	yes
sunny	mild	high	FALSE	no
sunny	cool	normal	FALSE	yes
rainy	mild	normal	FALSE	yes
sunny	mild	normal	TRUE	yes
overcast	mild	high	TRUE	yes
overcast	hot	normal	FALSE	yes
rainy	mild	high	TRUE	no

测试集也是这个数据集，只是将类标移除了

模型训练函数

train<-function(formula,train_data){
  #工具函数
  #计算一列数据的信息熵
  calculateEntropy <- function(train_data){
    t <- table(train_data)    #统计每种结果出现多少次
    sum <- sum(t)       #总次数
    t <- t[t!=0]        #去掉非0
    entropy <- -sum(log2(t/sum)*(t/sum))

    return(entropy)
  }

  #计算两列数据的信息熵
  calculateEntropy2 <- function(train_data){
    var <- table(train_data[1])
    p <- var/sum(var)
    varnames <- names(var)
    array <- c()
    for(name in varnames){
      array <- c(array,calculateEntropy(subset(train_data,train_data[1]==name,select=2)))
    }
    return(sum(array*p))
  }

  #参数准备
  library(Formula)
  result=list(formula=formula,train_data=train_data) #返回结果result是list（包含model）

  #解析formula
  rformula=attributes(Formula(formula))
  label=as.character(rformula$lhs) #获得类标列

  #获得参与模型的属性
  rhs=as.character(rformula$rhs)
  if(rhs=="."){  #"."代表取所有属性
    attributes=names(train_data)
    attributes=attributes[attributes!=label]

  }else{
    rhs=gsub("[N ]","",rhs)#去除空格
    attributes=unlist(strsplit(rhs,"[+]"))#获得属性向量
  }
  result=c(result,label=list(label),attributes=list(attributes))

  #初始化model
  entropy=calculateEntropy(train_data[,label])
  model<-data.frame(var="root",value=NA,entropy=entropy,class=NA)
  model$var=as.character(model$var) #否则变成factor，无法输入root以外的节点名称

  #核心函数-递归建立决策树
  buildTree <- function(train_data,label,attributes){
    #如果熵为0，停止递归
    if(length(unique(train_data[,label])) == 1){
      model<<-rbind(model,c("leaf",NA,0,unique(train_data[,label])))
      return()
    }
    #如果已经没有别的变量，但还不能完全分类，需要剪枝
    if(length(attributes) == 1){
      t<-table(train_data[,label])
      class=names(t)[t==max(t)]
      entropy=calculateEntropy(train_data[,label])
      model<<-rbind(model,c("leaf",NA,entropy,class))
      return()
    }
    #开始计算
    branch <- ""
    temp <- Inf
    subentropy <- c()
    for(attribute in attributes){
      temp2 <- calculateEntropy2(train_data[,c(attribute,label)])
      if(temp2 < temp){         
        temp <- temp2           #记录最小的信息熵
        branch <- attribute     #最小信息熵对应的类名
      }
    }

    attributes <- attributes[attributes!= branch]
    for(value in unlist(unique(train_data[,branch]))){
      model<<-rbind(model,c(branch,value,temp,NA))
      buildTree(subset(train_data,train_data[,branch]==value),label,attributes[attributes !=branch ])
    }
  }

  #执行递归函数并返回最终结果
  buildTree(train_data,label,attributes)
  result<-c(result,model=list(model))
  return(result) 
}

分类预测函数
决策树一般采用xml类格式存储，比较清晰也好用。作者也尝试过在R中使用，但比较麻烦且体现不了R的特色。经过再三考虑决定将决策树存储到数据框中，写入和利用它进行分类都比较方便。
为了模拟xml的格式，在数据框添加了“root”和”leaf”变量，这在之前的模型训练函数中可以看出来，之后遍历并读出每一个leaf对应的分类并赋予符合相应条件的数据。

predict<-function(result,predict_data){
  #参数处理（添加序号）,方便之后赋予类标签
  model=result$model
  predict_data=cbind(predict_data,id=as.numeric(rownames(predict_data)))

  #初始化类标向量
  labels=vector("character",nrow(predict_data))  

  #模拟xml文件，由于无节点概念，用model子集表示节点范围，subset为对应数据子集
  giveLable<-function(model,subset){

    #无数据提前终止
    if(nrow(subset)==0){
      return()
    }

    attribute=model$var[1]
    #判断是否是叶子节点
    if(attribute=="leaf"){
      class=model$class[1]
      temp=labels
      temp[subset$id]=class
      labels<<-temp
      return() 
    }

    indexs=which(model$var==attribute)
    values<-model$value[indexs]

    #按“节点”分类递归
    for(i in 1:length(indexs)){
      if(i!=length(indexs)){
        tmodel=model[(indexs[i]+1):(indexs[i+1]-1),]
      }else{
        tmodel=model[(indexs[i]+1):nrow(model),]
      }
      tsubset=subset[subset[,attribute]==values[i],]
      giveLable(tmodel,tsubset)
    }
  }

  giveLable(model[-1,],predict_data)#"自动"过滤root节点~
  return(labels)
}

使用效果

> result<-train(play~.,train_data)
> result$model
        var    value           entropy class
1      root     <NA> 0.940285958670631  <NA>
2   outlook    sunny 0.693536138896192  <NA>
3  humidity     high                 0  <NA>
4      leaf     <NA>                 0    no
5  humidity   normal                 0  <NA>
6      leaf     <NA>                 0   yes
7   outlook overcast 0.693536138896192  <NA>
8      leaf     <NA>                 0   yes
9   outlook    rainy 0.693536138896192  <NA>
10    windy    FALSE                 0  <NA>
11     leaf     <NA>                 0   yes
12    windy     TRUE                 0  <NA>
13     leaf     <NA>                 0    no
> predict(result,train_data[,1:4])
 [1] "no"  "no"  "yes" "yes" "yes" "no"  "yes" "no"  "yes" "yes" "yes" "yes" "yes" "no" 
> 

存在问题

没有像Java一样使用编号去表示子集，因为这在R中实现起来比较难麻烦，不如直接取数据子集来的方便。但是这样的问题是如果预测数据集过大，将占用较大的内存。
当然一般情况下决策树的数据集都比较小，因此大部分情况下选择本文中的实现方法都是比较合适的。