Skip to content

Commit 6d04136

Browse files
snoweyesnoweye
committed
update
1 parent 55ee681 commit 6d04136

File tree

7 files changed

+76
-45
lines changed

7 files changed

+76
-45
lines changed

‎DESCRIPTION‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -25,7 +25,7 @@ URL: http://r-pbd.org/
2525
BugReports: http://group.r-pbd.org/
2626
MailingList: Please send questions and comments regarding pbdR to
2727
[email protected]
28-
Packaged: 2013-05-30 19:14:43 UTC; snoweye
28+
Packaged: 2013-05-31 14:21:37 UTC; snoweye
2929
Author: Wei-Chen Chen [aut, cre],
3030
George Ostrouchov [aut]
3131
Maintainer: Wei-Chen Chen <[email protected]>

‎NAMESPACE‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -49,6 +49,7 @@ export(
4949

5050
### Utility functions.
5151
"get.N.CLASS",
52+
"get.CLASS",
5253

5354
### DMAT functions.
5455
### Readme function.

‎R/dmat_em_base.r‎

Lines changed: 30 additions & 44 deletions
Original file line numberDiff line numberDiff line change
@@ -20,13 +20,13 @@ update.expectation.dmat <- function(PARAM, update.logL = TRUE){
2020
K <- PARAM$K
2121

2222
### WCC: original
23-
.pmclustEnv$U.dmat <- sweep(.pmclustEnv$W.dmat, 2, PARAM$log.ETA)
23+
.pmclustEnv$U.dmat <- sweep(.pmclustEnv$W.dmat, 2, PARAM$log.ETA, FUN = "+")
2424
### WCC: temp dmat
25-
# tmp.1 <- sweep(.pmclustEnv$W.dmat, 2, PARAM$log.ETA)
25+
# tmp.1 <- sweep(.pmclustEnv$W.dmat, 2, PARAM$log.ETA, FUN = "+")
2626
# .pmclustEnv$U.dmat <- tmp.1
2727
### WCC: temp spmd
2828
# tmp.1 <- as.matrix(.pmclustEnv$W.dmat)
29-
# tmp.2 <- sweep(tmp.1, 2, PARAM$log.ETA)
29+
# tmp.2 <- sweep(tmp.1, 2, PARAM$log.ETA, FUN = "+")
3030
# .pmclustEnv$U.dmat <- as.ddmatrix(tmp.2)
3131

3232
### WCC: original
@@ -60,53 +60,53 @@ update.expectation.dmat <- function(PARAM, update.logL = TRUE){
6060
tmp.flag <- sum(tmp.id)
6161
if(tmp.flag > 0){
6262
### WCC: original
63-
tmp.dmat <- .pmclustEnv$U.dmat[tmp.id,]
63+
# tmp.dmat <- .pmclustEnv$U.dmat[tmp.id,]
6464
### WCC: temp spmd
65-
# tmp.1 <- as.matrix(.pmclustEnv$U.dmat)
66-
# tmp.2 <- tmp.1[tmp.id,]
67-
# if(tmp.flag == 1){
68-
# tmp.2 <- matrix(tmp.2, nrow = 1)
69-
# }
70-
# tmp.dmat <- as.ddmatrix(tmp.2)
65+
tmp.1 <- as.matrix(.pmclustEnv$U.dmat)
66+
tmp.2 <- tmp.1[tmp.id,]
67+
if(tmp.flag == 1){
68+
tmp.2 <- matrix(tmp.2, nrow = 1)
69+
}
70+
tmp.dmat <- as.ddmatrix(tmp.2)
7171

7272
if(tmp.flag == 1){
7373
### WCC: original
74-
tmp.scale <- max(tmp.dmat) - .pmclustEnv$CONTROL$exp.max / K
75-
tmp.scale <- as.vector(tmp.scale)
74+
# tmp.scale <- max(tmp.dmat) - .pmclustEnv$CONTROL$exp.max / K
75+
# tmp.scale <- as.vector(tmp.scale)
7676
### WCC: temp dmat
7777
# tmp.1 <- max(tmp.dmat)
7878
# tmp.2 <- tmp.1 - .pmclustEnv$CONTROL$exp.max / K
7979
# tmp.3 <- as.vector(tmp.2)
8080
# tmp.scale <- tmp.3
8181
### WCC: temp spmd
82-
# tmp.1 <- as.vector(tmp.dmat)
83-
# tmp.scale <- max(tmp.1) - .pmclustEnv$CONTROL$exp.max / K
82+
tmp.1 <- as.vector(tmp.dmat)
83+
tmp.scale <- max(tmp.1) - .pmclustEnv$CONTROL$exp.max / K
8484
} else{
8585
### WCC: original
86-
tmp.scale <- apply(tmp.dmat, 1, max) - .pmclustEnv$CONTROL$exp.max / K
87-
tmp.scale <- as.vector(tmp.scale)
86+
# tmp.scale <- apply(tmp.dmat, 1, max) - .pmclustEnv$CONTROL$exp.max / K
87+
# tmp.scale <- as.vector(tmp.scale)
8888
### WCC: temp dmat
8989
# tmp.1 <- apply(tmp.dmat, 1, max)
9090
# tmp.2 <- tmp.1 - .pmclustEnv$CONTROL$exp.max / K
9191
# tmp.3 <- as.vector(tmp.2)
9292
# tmp.scale <- tmp.3
9393
### WCC: temp spmd
94-
# tmp.1 <- as.matrix(tmp.dmat)
95-
# tmp.scale <- unlist(apply(tmp.1, 1, max)) -
96-
# .pmclustEnv$CONTROL$exp.max / K
94+
tmp.1 <- as.matrix(tmp.dmat)
95+
tmp.scale <- unlist(apply(tmp.1, 1, max)) -
96+
.pmclustEnv$CONTROL$exp.max / K
9797
}
9898
### WCC: original
99-
.pmclustEnv$Z.dmat[tmp.id,] <- exp(tmp.dmat - tmp.scale)
99+
# .pmclustEnv$Z.dmat[tmp.id,] <- exp(tmp.dmat - tmp.scale)
100100
### WCC: temp dmat
101101
# tmp.1 <- exp(tmp.dmat - tmp.scale)
102102
# .pmclustEnv$Z.dmat[tmp.id,] <- tmp.1
103103
### WCC: temp spmd
104-
# tmp.1 <- as.matrix(tmp.dmat)
105-
# tmp.1 <- exp(tmp.1 - tmp.scale)
106-
# tmp.id <- which(tmp.id)
107-
# tmp.2 <- as.matrix(.pmclustEnv$Z.dmat)
108-
# tmp.2[tmp.id,] <- tmp.1
109-
# .pmclustEnv$Z.dmat <- as.ddmatrix(Z.dmat)
104+
tmp.1 <- as.matrix(tmp.dmat)
105+
tmp.1 <- exp(tmp.1 - tmp.scale)
106+
tmp.id <- which(tmp.id)
107+
tmp.2 <- as.matrix(.pmclustEnv$Z.dmat)
108+
tmp.2[tmp.id,] <- tmp.1
109+
.pmclustEnv$Z.dmat <- as.ddmatrix(tmp.2)
110110
}
111111

112112
### WCC: original
@@ -133,14 +133,14 @@ update.expectation.dmat <- function(PARAM, update.logL = TRUE){
133133
# }
134134

135135
### WCC: original
136-
.pmclustEnv$Z.colSums <- as.vector(colSums(.pmclustEnv$Z.dmat))
136+
# .pmclustEnv$Z.colSums <- as.vector(colSums(.pmclustEnv$Z.dmat))
137137
### WCC: temp dmat
138138
# tmp.1 <- colSums(.pmclustEnv$Z.dmat)
139139
# tmp.2 <- as.vector(tmp.1)
140140
# .pmclustEnv$Z.colSums <- tmp.2
141141
### WCC: temp spmd
142-
# tmp.1 <- as.matrix(.pmclustEnv$Z.dmat)
143-
# .pmclustEnv$Z.colSums <- colSums(tmp.1)
142+
tmp.1 <- as.matrix(.pmclustEnv$Z.dmat)
143+
.pmclustEnv$Z.colSums <- colSums(tmp.1)
144144

145145
if(update.logL){
146146
.pmclustEnv$W.rowSums <- log(.pmclustEnv$W.rowSums)
@@ -149,6 +149,7 @@ update.expectation.dmat <- function(PARAM, update.logL = TRUE){
149149
.pmclustEnv$W.rowSums[tmp.id] + tmp.scale
150150
}
151151
}
152+
152153
invisible()
153154
} # End of update.expectation.dmat().
154155

@@ -166,18 +167,6 @@ m.step.dmat <- function(PARAM){
166167
p <- PARAM$p
167168
p.2 <- p * p
168169
for(i.k in 1:PARAM$K){
169-
170-
### Bug?
171-
B <- X.dmat * as.vector(.pmclustEnv$Z.dmat[, i.k])
172-
B <- as.matrix(B)
173-
comm.print(head(B))
174-
175-
tmp.1 <- as.matrix(X.dmat)
176-
tmp.2 <- as.matrix(.pmclustEnv$Z.dmat)
177-
B <- tmp.1 * tmp.2[, i.k]
178-
comm.print(head(B))
179-
comm.stop("bug here")
180-
181170
### MLE for MU
182171
### WCC: original
183172
# B <- colSums(X.dmat * as.vector(.pmclustEnv$Z.dmat[, i.k])) /
@@ -317,16 +306,13 @@ em.onestep.dmat <- function(PARAM){
317306
# Rprof(filename = "em.Rprof", append = TRUE)
318307
# }
319308

320-
comm.print("em.onestep.dmat m")
321309
PARAM <- m.step.dmat(PARAM)
322-
comm.print("em.onestep.dmat e")
323310
e.step.dmat(PARAM)
324311

325312
# if(.pmclustEnv$COMM.RANK == 0){
326313
# Rprof(NULL)
327314
# }
328315

329-
comm.print("em.onestep.dmat logL")
330316
PARAM$logL <- logL.step.dmat()
331317

332318
if(.pmclustEnv$CONTROL$debug > 0){

‎R/dmat_em_initial.r‎

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -17,6 +17,15 @@ initial.em.dmat <- function(PARAM, MU = NULL){
1717
PARAM$MU <- MU
1818
}
1919

20+
### For iris example.
21+
# PARAM$MU <- c(
22+
# -0.8976739, 1.3968289, 0.5514857,
23+
# 1.0156020, 0.3273175, 0.5567457,
24+
# -1.3357516, 0.5336209, 1.2700404,
25+
# -1.3110521, 0.2632600, 1.7063794
26+
# )
27+
# PARAM$MU <- matrix(PARAM$MU, nrow = 4)
28+
2029
e.step.dmat(PARAM)
2130
PARAM <- em.onestep.dmat(PARAM)
2231
PARAM$logL <- logL.step.dmat()

‎R/dmat_em_tools.r‎

Lines changed: 21 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -5,3 +5,24 @@ get.N.CLASS.dmat <- function(K){
55
tabulate(as.vector(.pmclustEnv$CLASS.dmat), nbins = K)
66
} # End of get.N.CLASS.dmat().
77

8+
9+
get.CLASS <- function(PARAM){
10+
A <- exists("CLASS.dmat", envir = .pmclustEnv)
11+
B <- exists("CLASS.spmd", envir = .pmclustEnv)
12+
13+
if(A & B){
14+
comm.stop("CLASS.spmd and CLASS.dmat both exist in .pmclustEnv")
15+
} else{
16+
if(A){
17+
ret <- spmd.allgather.integer(as.integer(.pmclustEnv$CLASS.spmd),
18+
integer(PARAM$N))
19+
ret <- unlist(ret)
20+
}
21+
if(B){
22+
ret <- as.integer(as.vector(.pmclustEnv$CLASS.dmat))
23+
}
24+
}
25+
26+
ret
27+
} # End of get.CLASS().
28+

‎R/pm_em_initial.r‎

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -48,6 +48,15 @@ initial.em.spmd <- function(PARAM, MU = NULL){
4848
PARAM$MU <- MU
4949
}
5050

51+
### For iris example.
52+
# PARAM$MU <- c(
53+
# -0.8976739, 1.3968289, 0.5514857,
54+
# 1.0156020, 0.3273175, 0.5567457,
55+
# -1.3357516, 0.5336209, 1.2700404,
56+
# -1.3110521, 0.2632600, 1.7063794
57+
# )
58+
# PARAM$MU <- matrix(PARAM$MU, nrow = 4)
59+
5160
e.step.spmd(PARAM)
5261
PARAM <- em.onestep.spmd(PARAM)
5362
PARAM$logL <- logL.step.spmd()

‎man/41-get.N.CLASS.Rd‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,18 +1,23 @@
11
\name{get.N.CLASS}
22
\alias{get.N.CLASS}
33
\alias{get.N.CLASS.dmat}
4+
\alias{get.CLASS}
45
\title{Obtain Total Elements for Every Clusters}
56
\description{
67
This function will collect the total elements for every clusters
78
from all processors that the all reduced calls with the sum operation
89
will be performed.
910

1011
\code{get.N.CLASS.dmat} is a \code{ddmatrix} version of \code{get.N.CLASS}.
12+
13+
The \code{get.CLASS} returns class ids.
1114
}
1215
\usage{
1316
get.N.CLASS(K)
1417

1518
get.N.CLASS.dmat(K)
19+
20+
get.CLASS()
1621
}
1722
\arguments{
1823
\item{K}{the total number of clusters.}

0 commit comments

Comments
 (0)