求R编写的K means 算法

是 否 +2 论坛币

k人 参与回答

经管之家送您一份

应届毕业生专属福利!

求职就业群

赵安豆老师微信：zhaoandou666

经管之家联合CDA

送您一个全额奖学金名额~ !

立即领取

感谢您参与论坛问题回答

经管之家送您两个论坛币！

+2 论坛币

R中stats包里的kmeans算法是调用C函数编写的版本。有没有谁可以帮忙提供一个R语言编写的kmeans 算法呢？
感激不尽！

扫码加我 拉你入群

请注明：姓名-公司-职位

以便审核进群资格，未注明则拒绝

分享0 收藏1 回帖

关键词：means mean ans kmeans stats means 算法 编写

哈哈，我今天刚好写了一个

二楼的朋友能不能把程序给我们看看啊。谢谢！

1. > kmeans
   
2. function (x, centers, iter.max = 10, nstart = 1, algorithm = c("Hartigan-Wong",
   
3.     "Lloyd", "Forgy", "MacQueen"))
   
4. {
   
5.     do_one <- function(nmeth) {
   
6.         Z <- switch(nmeth, {
   
7.             Z <- .Fortran("kmns", as.double(x), as.integer(m),
   
8.                 as.integer(ncol(x)), centers = as.double(centers),
   
9.                 as.integer(k), c1 = integer(m), integer(m), nc = integer(k),
   
10.                 double(k), double(k), integer(k), double(m),
    
11.                 integer(k), integer(k), as.integer(iter.max),
    
12.                 wss = double(k), ifault = as.integer(0L), PACKAGE = "stats")
    
13.             switch(Z$ifault, stop("empty cluster: try a better set of initial centers",
    
14.                 call. = FALSE), warning(gettextf("did not converge in %d iterations",
    
15.                 iter.max), call. = FALSE, domain = NA), stop("number of cluster centres must lie between 1 and nrow(x)",
    
16.                 call. = FALSE))
    
17.             Z
    
18.         }, {
    
19.             Z <- .C("kmeans_Lloyd", as.double(x), as.integer(m),
    
20.                 as.integer(ncol(x)), centers = as.double(centers),
    
21.                 as.integer(k), c1 = integer(m), iter = as.integer(iter.max),
    
22.                 nc = integer(k), wss = double(k), PACKAGE = "stats")
    
23.             if (Z$iter > iter.max)
    
24.                 warning("did not converge in ", iter.max, " iterations",
    
25.                   call. = FALSE)
    
26.             if (any(Z$nc == 0))
    
27.                 warning("empty cluster: try a better set of initial centers",
    
28.                   call. = FALSE)
    
29.             Z
    
30.         }, {
    
31.             Z <- .C("kmeans_MacQueen", as.double(x), as.integer(m),
    
32.                 as.integer(ncol(x)), centers = as.double(centers),
    
33.                 as.integer(k), c1 = integer(m), iter = as.integer(iter.max),
    
34.                 nc = integer(k), wss = double(k), PACKAGE = "stats")
    
35.             if (Z$iter > iter.max)
    
36.                 warning("did not converge in ", iter.max, " iterations",
    
37.                   call. = FALSE)
    
38.             if (any(Z$nc == 0))
    
39.                 warning("empty cluster: try a better set of initial centers",
    
40.                   call. = FALSE)
    
41.             Z
    
42.         })
    
43.         Z
    
44.     }
    
45.     x <- as.matrix(x)
    
46.     m <- nrow(x)
    
47.     if (missing(centers))
    
48.         stop("'centers' must be a number or a matrix")
    
49.     algorithm <- match.arg(algorithm)
    
50.     nmeth <- switch(algorithm, `Hartigan-Wong` = 1, Lloyd = 2,
    
51.         Forgy = 2, MacQueen = 3)
    
52.     if (length(centers) == 1) {
    
53.         k <- centers
    
54.         if (nstart == 1)
    
55.             centers <- x[sample.int(m, k), , drop = FALSE]
    
56.         if (nstart >= 2 || any(duplicated(centers))) {
    
57.             cn <- unique(x)
    
58.             mm <- nrow(cn)
    
59.             if (mm < k)
    
60.                 stop("more cluster centers than distinct data points.")
    
61.             centers <- cn[sample.int(mm, k), , drop = FALSE]
    
62.         }
    
63.     }
    
64.     else {
    
65.         centers <- as.matrix(centers)
    
66.         if (any(duplicated(centers)))
    
67.             stop("initial centers are not distinct")
    
68.         cn <- NULL
    
69.         k <- nrow(centers)
    
70.         if (m < k)
    
71.             stop("more cluster centers than data points")
    
72.     }
    
73.     if (iter.max < 1)
    
74.         stop("'iter.max' must be positive")
    
75.     if (ncol(x) != ncol(centers))
    
76.         stop("must have same number of columns in 'x' and 'centers'")
    
77.     Z <- do_one(nmeth)
    
78.     if (nstart >= 2 && !is.null(cn)) {
    
79.         best <- sum(Z$wss)
    
80.         for (i in 2:nstart) {
    
81.             centers <- cn[sample.int(mm, k), , drop = FALSE]
    
82.             ZZ <- do_one(nmeth)
    
83.             if ((z <- sum(ZZ$wss)) < best) {
    
84.                 Z <- ZZ
    
85.                 best <- z
    
86.             }
    
87.         }
    
88.     }
    
89.     centers <- matrix(Z$centers, k)
    
90.     dimnames(centers) <- list(1L:k, dimnames(x)[[2L]])
    
91.     cluster <- Z$c1
    
92.     if (!is.null(rn <- rownames(x)))
    
93.         names(cluster) <- rn
    
94.     out <- list(cluster = cluster, centers = centers, withinss = Z$wss,
    
95.         size = Z$nc)
    
96.     class(out) <- "kmeans"
    
97.     out
    
98. }
    
99. <environment: namespace:stats>

复制代码

楼主想要看的是编码吗？直接输入kmeans就可以看到编码了...