fuzzy decision tree

##con2fuz,R

#连续数据集转化为模糊数据集

con2fuz <- function(D,CENTER){
m <- ncol(D)
X <- D[-m]
Y <- D[,m]
Y <- class.ind(Y)
my <- ncol(Y)
names(my) <- names(D[m])
FX <- trimf3(X,CENTER)
SIZE <- c(sapply(CENTER,length),my)
SF <- list(SIZE=SIZE,FD=data.frame(FX,Y))
return(SF)

}

##f_forecast.R

#判断规则与样本是否匹配
frule_match <- function(x,NAMES,rule,alpha){
m <- length(rule)
y <- rule[1:(m-2)]
ID <- which(NAMES%in%y)
return(all(x[ID]>=alpha))
}
#单个样本分类
f_classify <- function(x,NAMES,RULE,alpha){
temp <- sapply(RULE,frule_match,x=x,NAMES=NAMES,alpha=alpha)
temp <- which(temp)
NEWRULE <- RULE[temp]
m <- length(NEWRULE)
MAX <- -1
for(i in 1:m){
rule <- NEWRULE[[i]]
mr <- length(rule)
CF <- as.numeric(rule[mr])
if(MAX<CF){
MAX <- CF
class <- rule[mr-1]
}
}
return(class)
}
#数据集样本分类
f_forecast <- function(X,RULE,alpha){
NAMES <- names(X)
result <- apply(X,1,f_classify,NAMES=NAMES,RULE=RULE,alpha=alpha)
return(result)
}

##fg_tree.R
#生成节点
fg_node <- function(SF,ST,parent,attribute,value,alpha,belta,theta){
#产生一个新节点，树的规模加一
ST$SIZE <- ST$SIZE+1
node <- list(parent=parent,ID=ST$SIZE)
if(node$parent!=0){
node$attribute <- attribute
node$value <- value
}
#判断是否产生叶节点
m <- length(SF$SIZE)
C <- SF$FD[(sum(SF$SIZE)-SF$SIZE[m]+1):sum(SF$SIZE)]
Validity <- validity(C)
flag <- FALSE
if(m==1|Validity>belta) flag <- TRUE
#产生叶节点的情况
if(flag){
node$type <- "leaf"
node$class <- names(Validity)
node$CF <- as.vector(Validity)
ST$TREE[[node$ID]] <- node
return(ST)
}
#产生分支节点的情况
node$type <- "split"
Att <- fs_att(SF)
node$split_attribute <- Att
ST$TREE[[node$ID]] <- node
#生成新节点
parent <- node$ID
attribute <- Att
id <- which(names(SF$SIZE)==Att)
Range <- (sum(SF$SIZE[1:id])-SF$SIZE[id]+1):sum(SF$SIZE[1:id])
for(i in Range){
value <- names(SF$FD[i])
ID <- SF$FD[,i]>=alpha
subSF <- list(SIZE=SF$SIZE[-id],FD=SF$FD[ID,-Range])
m <- length(subSF$SIZE)
subC <- subSF$FD[(sum(subSF$SIZE)-subSF$SIZE[m]+1):sum(subSF$SIZE)]
sumC <- sum(as.matrix(subC))#sum作用于空数据框会报错
Validity <- validity(subC)
if(sumC<theta){
ST$SIZE <- ST$SIZE+1
node <- list(parent=parent,ID=ST$SIZE)
node$type <- "leaf"
node$attribute <- attribute
node$value <- value
node$class <- names(Validity)
node$CF <- as.vector(Validity)
ST$TREE[[node$ID]] <- node
}else{
ST <- fg_node(subSF,ST,parent,
attribute,value,alpha,belta,theta)
}
}
return(ST)
}

#生成树
fg_tree <- function(SF,alpha,belta,theta){
#设置初值
#节点有两种:
#分支节点（含可进一步分类的根节点）
#叶节点（含不可进一步分类的根节点）
#分枝节点（split）：
#parent：节点的父节点在树（列表）中的地址（根节点的父节点为0）
#ID：节点在树（列表）中的地址
#split_attribute：子节点的属性
#attribute：节点的属性(非根节点才存在)
#value：节点的属性值(非根节点才存在)
#叶节点（leaf）：
#parent：节点的父节点在树（列表）中的地址（根节点的父节点为0）
#ID：节点在树（列表）中的地址
#class：节点的分类属性值
#attribute：节点的属性(非根节点才存在)
#value：节点的属性值(非根节点才存在)
#CF：节点的真实度
ST <- list(SIZE=0,TREE=list())#ST:规模和树的缩写
ST <- fg_node(SF,ST,0,attribute,value,alpha,belta,theta)
return(ST)
}

##fs_att.R
#模糊信息熵
f_ent <- function(C){
#C:数据框
s <- sum(C)+eps
temp <- sapply(C,sum)/s
Ent <- -sum(temp*log(temp+eps,2))
return(Ent)
}
#模糊条件信息熵
fc_ent <- function(a,C){
#a、C:数据框
m <- ncol(C)
aC <- C
for(i in 1:m)
aC[,i] <- apply(cbind(C[i],a),1,min)
Ent <- f_ent(aC)
return(Ent)
}
#模糊信息增益
f_gain <- function(A,C){
#A、C:数据框
m <- ncol(A)
s <- sum(A)+eps
Gain <- f_ent(C)
for(i in 1:m)
Gain <- Gain-sum(A[,i])/s*fc_ent(A[,i],C)
return(Gain)
}
#模糊分裂属性
fs_att <- function(SF){
SIZE <- SF$SIZE
FD <- SF$FD
m <- length(SIZE)
MAX <- -1
C <- FD[(sum(SIZE[1:(m-1)])+1):sum(SIZE)]
for(i in 1:(m-1)){
A <- FD[(sum(SIZE[1:(i-1)])+1):sum(SIZE[1:i])]
Gain <- f_gain(A,C)
if(MAX<Gain){
MAX <- Gain
id <- i
}
}
Att <- names(SIZE)[id]
return(Att)
}


##get_center.R

#求模糊集合的中心
get_center <- function(X,k){
m <- ncol(X)
NAMES <- names(X)
CENTER <- list()
for(i in 1:m){
temp <- kmeans(X[,i],k)
CENTER[[i]] <- sort(temp$centers)
}
names(CENTER) <- NAMES
return(CENTER)
}

##get_rule.R

#获得叶节点
get_leaf <- function(ST){
SL <- list(SIZE=0,LEAF=list())
for(i in 1:ST$SIZE){
if(ST$TREE[[i]]$type=="leaf"){
SL$SIZE <- SL$SIZE+1
SL$LEAF[[SL$SIZE]] <- ST$TREE[[i]]
}
}
return(SL)
}
#获得规则
get_rule <- function(ST){
SL <- get_leaf(ST)
RULE <- list()
for(i in 1:SL$SIZE){
rule <- c()
attribute <- c()
cnt <- 1
node <- SL$LEAF[[i]]
rule[cnt] <- node$CF
attribute[cnt] <- "CF"
cnt <- 2
node <- SL$LEAF[[i]]
rule[cnt] <- node$class
attribute[cnt] <- "Class"
while(node$parent!=0){
cnt <- cnt+1
rule[cnt] <- node$value
attribute[cnt] <- node$attribute
node <- ST$TREE[[node$parent]]
}
rule <- rule[cnt:1]
attribute <- attribute[cnt:1]
names(rule) <- attribute
RULE[[i]] <- rule
}
return(RULE)
} 

##trimf3.R

#处理标量的三角隶属度函数
trimf1 <- function(x,a,b,c){
y <- 0
if(x>=a&x<=b){
y <- (x-a)/(b-a+eps)
}else if(x>b&x<=c){
y <- (c-x)/(c-b+eps)
}
return(y)
}
#处理向量的三角隶属度函数
trimf2 <- function(x,a,b,c){
#x:向量
#a,b,c:分别代表三个相邻模糊集合的中心
y <- sapply(x,trimf1,a,b,c)
return(y)
}
#处理数据框的三角隶属度函数
trimf3 <- function(X,CENTER){
SIZE <- sapply(CENTER,length)
NAMES <- names(SIZE)
FX <- X[,0]
m <- ncol(X)
cnt <- 0
for(i in 1:m){
center <- c(-inf,CENTER[[i]],inf)
for (j in 2:(SIZE[i]+1)){
cnt <- cnt+1
FX <- data.frame(FX,trimf2(X[,i],
center[j-1],center[j],center[j+1]))
names(FX)[cnt] <- paste(NAMES[i],
ALPHABET[j],sep="_")
}
}
return(FX)
}

##validity.R

#置信度
validity <- function(C){
Validity <- -1
sumC <- sum(as.matrix(C))+eps
temp <- sapply(C,sum)+eps
temp <- temp/sumC
id <- which.max(temp)
return(temp[id])
}


##method.R

library(nnet)
ALPHABET <- c(" ","A","B","C","D","E","F","G","H","I",
"J","K","L","M","N","O","P","Q","R","S",
"T","U","V","W","X","Y","Z")
inf <- 1e100#无穷大
eps <- 1e-100#无穷小
source("get_center.R")
source("trimf3.R")
source("con2fuz.R")
source("fs_att.R")
source("validity.R")
source("fg_tree.R")
source("get_rule.R")
source("f_forecast.R")

##main.R

D <- iris
k <- 3
alpha <- 0.5
belta <- 0.85
theta <- 5
#随机分层抽样
n <- nrow(D)
m <- ncol(D)
Class <- levels(D[,m])
ID <- NULL
for(i in Class){
ID0 <- which(D[,m]==i)
n0 <- length(ID0)
ID <- c(ID,sample(ID0,n0/3))
}
TRAIN <- D[-ID,]
TEST <- D[ID,]
#生成规则
source("method.R")
m <- ncol(TRAIN)
X <- TRAIN[-m]
CENTER <- get_center(X,k)
SF <- con2fuz(TRAIN,CENTER)
ST <- fg_tree(SF,alpha,belta,theta)
RULE <- get_rule(ST)
#预测
FX <- trimf3(TEST[-m],CENTER)
result <- f_forecast(FX,RULE,alpha)
sum(result==TEST[,m])/length(TEST[,m])
RULE