R语言 模糊c均值(FCM)算法程序(转)

FCM <- function(x, K, mybeta = 2, nstart = 1, iter_max = 100, eps = 1e-06) {
  ## FCM

  ## INPUTS
  ##   x: input matrix n*d, n  d-dim samples
  ##   K: number of desired clusters
  ##   Optional :
  ##       mybeta : beta, exponent for u (defaut 2).
  ##       nstart:  how many random sets should be chosen(defaut 1)
  ##       iter_max : The maximum number of iterations allowed. (default 100)

  ##
  ## OUTPUTS
  ##   u: The fuzzy membership matrix = maxtrix of size n*K;
  ##   g: matrix of size K*d of the centers of the clusters
  ##   J: objective function
  ##   histJ: all the objective function values in the iter process

  ## modified time: 2015-02-07

    FCM_onetime <- function(x, init_centers, mybeta = 2, iter_max = 100, eps = 1e-06) {
        n = dim(x)[1]
        d = dim(x)[2]
        g = init_centers
        K = dim(g)[1]
        histJ = c()
        pasfini = 1
        Jold = Inf
        D = matrix(0, n, K)
        for (j in 1:K) {
            D[, j] = rowSums(sweep(x, 2, g[j, ], "-")^2)
        }
        iter = 1
        J_old = Inf
        while (pasfini) {
            s = (1/(D + eps))^(1/(mybeta - 1))
            u = s/(s %*% matrix(1, K, K))
            t1 = t(u^mybeta) %*% x
            t2 = t(u^mybeta) %*% matrix(1, n, d)
            V = t1/t2
            g = V
            D = matrix(0, n, K)
            for (j in 1:K) {
                D[, j] = rowSums(sweep(x, 2, g[j, ], "-")^2)
            }
            J = sum(u^mybeta * D)
            pasfini = abs(J - Jold) > 0.001 && (iter < iter_max)
            Jold = J
            histJ = c(histJ, J)
            iter = iter + 1
        }
        cluster_id = apply(u, 1, which.max)
        re = list(u, J, histJ, g, cluster_id)
        names(re) = c("u", "J", "histJ", "g", "cluster_id")
        return(re)
    }
    x = as.matrix(x)
    seeds = 1:nrow(x)
    id = sample(seeds, K)
    g = as.matrix(x[id, ])
    re_best = FCM_onetime(x = x, init_centers = g, mybeta = mybeta, iter_max = iter_max, eps = eps)
    if (nstart > 1) {
        minJ = 0
        i = 2
        while (i <= nstart) {
            init_centers_id = sample(seeds, K)
            init_centers = as.matrix(x[init_centers_id, ])
            run = FCM_onetime(x, init_centers = init_centers, mybeta = mybeta, iter_max = iter_max)
            if (run$J <= re_best$J) {
                re_best = run
            }
            i = i + 1
        }
    }
    return(re_best)
} 
# 对于模糊聚类均值的公式及其推到,大致如下:

#主要代码参见下面:(其中使用kmeans作比较。然后通过svm分类测验训练)
# 设置伪随机种子
set.seed(100)

# 生产数据样本
simple.data = function (n=200, nclass=2)
{
    require(clusterGeneration)
    require(mvtnorm)
    # Center of Gaussians
    xpos = seq(-nclass*2, nclass*2, length=nclass)
    ypos = runif(nclass, min=-2*nclass, max=2*nclass)

    func = function(i,xpos,ypos,n) {
        # Create a random covariance matrix
        cov = genPositiveDefMat(2, covMethod="eigen",
                            rangeVar=c(1, 10), lambdaLow=1, ratioLambda=10)
        # 保存随机数据
        data = rmvnorm(n=n, mean=c(xpos[i], ypos[i]), sigma=cov$Sigma)
        # 保存每一次的结果
        list(means=cbind(xpos[i], ypos[i]), covars=cov$Sigma, data=data,class=rep(i*1.0, n))
    }
    # do call 合并列表 为 数据框
    strL=do.call(rbind,lapply(1:nclass,func,xpos,ypos,n))
    data=list()
    data$means=do.call(rbind,strL[,1])
    data$covars = as.list(strL[,2])
    data$data=do.call(rbind,strL[,3])
    data$class=do.call(c,strL[,4])
    # 返回
    data
}

# 第一次随机产生u值 nr点个数  k 类别数
random.uij = function(k,nr)
{
    #
    u = matrix(data=round(runif(k*nr,10,20)),nrow=k,ncol=nr,
               dimnames=list(paste(‘u‘,1:k,sep=""),paste(‘x‘,1:nr,sep=‘‘)))
    tempu = function(x)
    {
        ret = round(x/sum(x),4)
        # 保证每一列之和为1
        ret[1] = 1-sum(ret[-1])
        ret
    }
    apply(u,2,tempu)
}

# 计算 点矩阵 到 中心的距离
dist_cc_dd = function(cc,dd)
{
    # cc 为 中心点  dd 为样本点值
    temp = function(cc,dd)
    {
        # 计算每一个中心点与每一个点的距离
        temp1 = function(index)
        {
            sqrt(sum(index^2))
        }
        # 结果向量以列存放,后面的结果需要转置,按行存储
        apply(dd-cc,2,temp1)
    }
    # 将结果转置
    t(apply(cc,1,temp,dd))
}

# 模糊均值聚类
fuzzy.cmeans = function(data,u,m=3)
{
    # 简单的判断,可以不要
    if (is.array(data) || is.matrix(data))
    {
        data = as.data.frame(data)
    }

#     nr = nrow(data)
#     nc = ncol(data)

#     while (J > lim && step < steps)
#     {
#         step = step + 1
        # uij 的 m 次幂
        um = u^m
        rowsum = apply(um,1,sum)
        # 求中心点 ci
        cc = as.matrix(um/rowsum) %*% as.matrix(data)
        #     rownames(cc)=paste(‘c‘,1:k,sep=‘‘)
        #     colnames(cc)=paste(‘x‘,1:nc,sep=‘‘)
        # 计算 J 值
        distance = dist_cc_dd(cc,t(data))
        J = sum(distance^2 * um)
        #     cc_temp = matrix(rep(cc,each=nr),ncol=2)
        #     dd_temp = NULL
        #     lapply(1:k,function(i){dd_temp <<- rbind(dd_temp,data)})
        #     dist = apply((dd_temp-cc_temp)^2,1,sum)
        #     um_temp = as.vector(t(um))
        #     J = um_temp %*% dist

        # 计算幂次系数,后面需要使用m != 1
        t = -2 / (m - 1)
        # 根据公式 计算
        tmp = distance^t
        colsum = apply(tmp,2,sum)
        mat = rep(1,nrow(cc)) %*% t(colsum)
        # 计算 uij,如此u的每一列之和为0
        u = tmp / mat
#     }
#     u
    # 保存一次迭代的结果值
    list(U = u,C = cc,J = J)
}

# 设置初始化参数
n = 100
k = 4
dat = simple.data(n,k)
nr = nrow(dat$data)
m = 3
limit = 1e-4
max_itr=50
# 随机初始化 uij
u = random.uij(k,nr)
results = list()
data=dat$data

# 迭代计算 收敛值
for (i in 1 : max_itr)
{
    results[[i]] = fuzzy.cmeans(dat$data,u,m)
    if (i != 1 && abs((results[[i]]$J - results[[i-1]]$J)) < limit)
    {
        break
    }
    u = results[[i]]$U
}

# 做散点图
require(ggplot2)
data=as.data.frame(dat$data,stringsAsFactors=FALSE)
data=cbind(data,dat$class)
nc = ncol(data)
colnames(data)=paste(‘x‘,1:nc,sep=‘‘)
# par(mar=rep(2,4))
p=ggplot(data,aes(x=x1,y=x2,color=factor(x3)))
p+geom_point()+xlab(‘x轴‘)+ylab(‘y轴‘)+ggtitle(‘scatter points‘)

# plot(dat$data,col=factor(dat$class))
# points(results[[i]]$C,pch=19,col=1:uniqe(dat$class))
# Sys.sleep(1)

# 计算聚类与原始类的误差比率
tclass=apply(results[[i]]$U,2,function(x){which(x==max(x))})
tclass[tclass==2]=5
tclass[tclass==3]=6
tclass[tclass==4]=7
tclass[tclass==5]=4
tclass[tclass==6]=2
tclass[tclass==7]=3

freq=table(dat$class,tclass)
(sum(freq)-sum(diag(freq))) / sum(freq)

# 训练 svm model
svm_test = function()
{
    library(e1071)
    svm.fit = svm(dat$data,dat$class)
    r.fit = predict(svm.fit, dat$data)
    diff.class = round(as.numeric(r.fit)) - as.numeric(dat$class)
    i.misclass = which(abs(diff.class) > 0)
    n.misclass = length(i.misclass)
    f.misclass = n.misclass/length(dat$class)
}
# 同一数据,使用 kmeans 聚类
kmeans_test = function()
{

    k.fit = kmeans(x=dat$data,4)
    tclass=k.fit$cluster
    tclass[tclass==2]=5
    tclass[tclass==3]=6
    tclass[tclass==4]=7
    tclass[tclass==5]=3
    tclass[tclass==6]=4
    tclass[tclass==7]=2
    freq=table(dat$class,tclass)
    (sum(freq)-sum(diag(freq))) / sum(freq)
}

# kmeans 和 fuzzy c means 
时间: 2024-10-12 23:09:31

R语言 模糊c均值(FCM)算法程序(转)的相关文章

使用R语言计算均值,方差等

R语言对于数值计算很方便,最近用到了计算方差,标准差的功能,特记录. 数据准备 height <- c(6.00, 5.92, 5.58, 5.92) 1 计算均值 mean(height) [1] 5.855 2 计算中位数 median(height) [1] 5.92 3 计算标准差 sd(height) [1] 0.1871719 4 计算方差 var(height) [1] 0.03503333 5 计算两个变量之间的相关系数 cor(height,log(height)) [1] 0

基于R语言的数据分析和挖掘方法总结——均值检验

2.1 单组样本均值t检验(One-sample t-test) 2.1.1 方法简介 t检验,又称学生t(student t)检验,是由英国统计学家戈斯特(William Sealy Gosset, 1876-1937)所提出,student则是他的笔名.t检验是一种检验总体均值的统计方法,当数据中仅含单组样本且样本数较大时(通常样本个数≧30的样本可视为样本数较大),可用这种方法来检验总体均值是否大于.小于或等于某一特定数值.当数据中仅含单组样本但样本数较小时(通常样本个数<30的样本可视为

R语言数据挖掘实战系列(5)

R语言数据挖掘实战系列(5)--挖掘建模 一.分类与预测 分类和预测是预测问题的两种主要类型,分类主要是预测分类标号(离散属性),而预测主要是建立连续值函数模型,预测给定自变量对应的因变量的值. 1.实现过程 (1)分类 分类是构造一个分类模型,输入样本的属性值,输出对应的类别,将每个样本映射到预先定义好的类别.分类模型建立在已有类标记的数据集上,模型在已有样本上的准确率可以方便地计算,所以分类属于有监督的学习. (2)预测 预测是建立两种或两种以上变量间相互依赖的函数模型,然后进行预测或控制.

R语言多元分析系列

R语言多元分析系列之一:主成分分析 主成分分析(principal components analysis, PCA)是一种分析.简化数据集的技术.它把原始数据变换到一个新的坐标系统中,使得任何数据投影的第一大方差在第一个坐标(称为第一主成分)上,第二大方差在第二个坐标(第二主成分)上,依次类推.主成分分析经常用减少数据集的维数,同时保持数据集的对方差贡献最大的特征.这是通过保留低阶主成分,忽略高阶主成分做到的.这样低阶成分往往能够保留住数据的最重要方面.但是在处理观测数目小于变量数目时无法发挥

R语言︱异常值检验、离群点分析、异常值处理

在数据挖掘的过程中,数据预处理占到了整个过程的60% 脏数据:指一般不符合要求,以及不能直接进行相应分析的数据 脏数据包括:缺失值.异常值.不一致的值.重复数据及含有特殊符号(如#.¥.*)的数据 数据清洗:删除原始数据集中的无关数据.重复数据.平滑噪声数据.处理缺失值.异常值等 缺失值处理:删除记录.数据插补和不处理 主要用到VIM和mice包 install.packages(c("VIM","mice")) 1.处理缺失值的步骤 步骤: (1)识别缺失数据:

R语言实战(五)方差分析与功效分析

本文对应<R语言实战>第9章:方差分析:第10章:功效分析 ==================================================================== 方差分析: 回归分析是通过量化的预测变量来预测量化的响应变量,而解释变量里含有名义型或有序型因子变量时,我们关注的重点通常会从预测转向组别差异的分析,这种分析方法就是方差分析(ANOVA).因变量不只一个时,称为多元方差分析(MANOVA).有协变量时,称为协方差分析(ANCOVA)或多元协方差分析

R语言基础入门之二:数据导入和描述统计

by 写长城的诗 • October 30, 2011 • Comments Off This post was kindly contributed by 数据科学与R语言 - go there to comment and to read  the full post. 一.数据导入 对初学者来讲,面对一片空白的命令行窗口,第一道真正的难关也许就是数据的导入.数据导入有很多途径,例如从网页抓取.公共数据源获得.文本文件导入.为了快速入门,建议初学者采取R语言协同Excel电子表格的方法.也就

基于R语言的数据分析和挖掘方法总结——描述性统计

1.1 方法简介 描述性统计包含多种基本描述统计量,让用户对于数据结构可以有一个初步的认识.在此所提供之统计量包含: 基本信息:样本数.总和 集中趋势:均值.中位数.众数 离散趋势:方差(标准差).变异系数.全距(最小值.最大值).内四分位距(25%分位数.75%分位数) 分布描述:峰度系数.偏度系数 用户可选择多个变量同时进行计算,亦可选择分组变量进行多组别的统计量计算. 1.2 详细介绍 1.2.1 样本数和总和 1. R语言涉及的方法:length(x) 1.2.2 均值(Mean) 1.

《R语言实战》学习笔记seventh

由于在准备软考中级数据库系统工程师外加巩固SQL Server 2012,所以拖了好久一直没继续学R 下去 所以今天重开R 的战事 这次是关于基本统计分析的内容,即关于用于生成基本的描述性统计量和推断统计量的R 函数 首先,将着眼于定量变量的位置和尺度的衡量方式 然后将是生成类别型变量的频数表和列联表的方法(以及连带的卡方检验) 接下来将考察连续型和有序型变量相关系数的多种形式 最后转而通过参数检验(t检验)和非参数检验(Mann-Whitney U检验.Kruskal-Wallis检验)方法研