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

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

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

    R语言对于数值计算很方便,最近用到了计算方差,标准差的功能,特记录. 数据准备 height <- c(6.00, 5.92, 5.58, 5.92) 1 计算均值 mean(height) [ ...

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

    2.1 单组样本均值t检验(One-sample t-test) 2.1.1 方法简介 t检验,又称学生t(student t)检验,是由英国统计学家戈斯特(William Sealy Gosset, ...

  3. 模糊C均值聚类-FCM算法

    FCM(fuzzy c-means) 模糊c均值聚类融合了模糊理论的精髓.相较于k-means的硬聚类,模糊c提供了更加灵活的聚类结果.因为大部分情况下,数据集中的对象不能划分成为明显分离的簇,指派一 ...

  4. R语言均值,中位数和模式

    R语言均值,中位数和模式 在R统计分析是通过用许多内置函数来执行的. 大多数这些函数是R基本包的一部分.这些函数需要R向量作为输入参数并给出结果. 我们正在讨论本章中的函数是平均数,中位数和模式. 平 ...

  5. 多核模糊C均值聚类

    摘要: 针对于单一核在处理多数据源和异构数据源方面的不足,多核方法应运而生.本文是将多核方法应用于FCM算法,并对算法做以详细介绍,进而采用MATLAB实现. 在这之前,我们已成功将核方法应用于FCM ...

  6. 用R语言的quantreg包进行分位数回归

    什么是分位数回归 分位数回归(Quantile Regression)是计量经济学的研究前沿方向之一,它利用解释变量的多个分位数(例如四分位.十分位.百分位等)来得到被解释变量的条件分布的相应的分位数 ...

  7. 如何在R语言中使用Logistic回归模型

    在日常学习或工作中经常会使用线性回归模型对某一事物进行预测,例如预测房价.身高.GDP.学生成绩等,发现这些被预测的变量都属于连续型变量.然而有些情况下,被预测变量可能是二元变量,即成功或失败.流失或 ...

  8. R语言解读一元线性回归模型

    转载自:http://blog.fens.me/r-linear-regression/ 前言 在我们的日常生活中,存在大量的具有相关性的事件,比如大气压和海拔高度,海拔越高大气压强越小:人的身高和体 ...

  9. R语言实战(三)基本图形与基本统计分析

    本文对应<R语言实战>第6章:基本图形:第7章:基本统计分析 =============================================================== ...

随机推荐

  1. Java中集合框架,Collection接口、Set接口、List接口、Map接口,已经常用的它们的实现类,简单的JDK源码分析底层实现

    (一)集合框架: Java语言的设计者对常用的数据结构和算法做了一些规范(接口)和实现(实现接口的类).所有抽象出来的数据结构和操作(算法)统称为集合框架. 程序员在具体应用的时候,不必考虑数据结构和 ...

  2. 数据库Schema两种含义~~

    1.数据库Schema有两种含义,一种是概念上的Schema,指的是一组DDL语句集,该语句集完整地描述了数据库的结构.还有一种是物理上的 Schema,指的是数据库中的一个名字空间,它包含一组表.视 ...

  3. node-webkit学习之【无边框窗口用JS实现拖动改变大小等】

    效果如下图 原生的如下图(原生的用在自己的app上面太丑了,并且还带边框,所以重写了左上角的三个功能键) 1.首先了解一下nw底下的package.json 文件 { "name" ...

  4. MySQL最常用分组聚合函数

    一.聚合函数(aggregation function)---也就是组函数 在一个行的集合(一组行)上进行操作,对每个组给一个结果. 常用的组函数: AVG([distinct] expr) 求平均值 ...

  5. glup/grunt,browserify / webpack等的比较

    gulp/grunt的比较: Gulp / Grunt 是一种工具,能够优化前端工作流程.比如自动刷新页面.combo.压缩css.js.编译less等等.简单来说,就是使用Gulp/Grunt,然后 ...

  6. xmlplus 组件设计系列之六 - 下拉刷新

    "下拉刷新"由著名设计师 Loren Brichter 设计,并应用于 Twitter 第三方应用 Tweetie 中.2010年4月,Twitter 收购 Tweetie 开发商 ...

  7. (知识点)JavaScript闭包

    下面是我对闭包的理解:(把他们整理出来,整理的过程也是在梳理) 1.首先,在理解闭包之前: 我们首先应该清楚下作用域和作用域链 作用域:每个函数定义时创建时自己的环境即作用域 作用域链:函数内可访问自 ...

  8. 安卓和iOS移动APP开发设计应该考虑哪些问题

    应该考虑哪些问题 现在用移动设备上网的用户越来越多,企业也可以从移动APP端挖掘潜在用户,想要设计好一款移动APP,我们需要考虑哪几个问题呢? 首先 我们应该先确认清楚企业的移动互联网战略目标是什么? ...

  9. React学习(一)父子组件通讯

    React父子组件之间通讯,利用props和state完成,首先React是单向数据流,父组件可以向子组件传递props: 实现父子组件双向数据流整体的思路是: 1,父组件可以向子组件传递props, ...

  10. 浅谈JavaScript匿名函数与闭包

    一. 匿名函数   //普通函数定义: //单独的匿名函数是无法运行的.就算运行了,也无法调用,因为没有名称. 如: function(){             alert('123');    ...