Skip to content

Commit 55ee681

Browse files
snoweyesnoweye
committed
update
1 parent 3d56dd8 commit 55ee681

File tree

6 files changed

+74
-91
lines changed

6 files changed

+74
-91
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 17:13:09 UTC; snoweye
28+
Packaged: 2013-05-30 19:14:43 UTC; snoweye
2929
Author: Wei-Chen Chen [aut, cre],
3030
George Ostrouchov [aut]
3131
Maintainer: Wei-Chen Chen <[email protected]>

‎R/dmat_em_base.r‎

Lines changed: 70 additions & 85 deletions
Original file line numberDiff line numberDiff line change
@@ -20,138 +20,111 @@ 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)
2424
### WCC: temp dmat
2525
# tmp.1 <- sweep(.pmclustEnv$W.dmat, 2, PARAM$log.ETA)
2626
# .pmclustEnv$U.dmat <- tmp.1
2727
### WCC: temp spmd
28-
tmp.1 <- as.matrix(.pmclustEnv$W.dmat)
29-
tmp.2 <- sweep(tmp.1, 2, PARAM$log.ETA)
30-
.pmclustEnv$U.dmat <- as.ddmatrix(tmp.2)
28+
# tmp.1 <- as.matrix(.pmclustEnv$W.dmat)
29+
# tmp.2 <- sweep(tmp.1, 2, PARAM$log.ETA)
30+
# .pmclustEnv$U.dmat <- as.ddmatrix(tmp.2)
3131

3232
### WCC: original
33-
# .pmclustEnv$Z.dmat <- exp(.pmclustEnv$U.dmat)
33+
.pmclustEnv$Z.dmat <- exp(.pmclustEnv$U.dmat)
3434
### WCC: temp dmat
3535
# tmp.1 <- exp(.pmclustEnv$U.dmat)
3636
# .pmclustEnv$Z.dmat <- tmp.1
3737
### WCC: temp spmd
38-
tmp.1 <- as.matrix(.pmclustEnv$U.dmat)
39-
tmp.2 <- exp(tmp.1)
40-
.pmclustEnv$Z.dmat <- as.ddmatrix(tmp.2)
38+
# tmp.1 <- as.matrix(.pmclustEnv$U.dmat)
39+
# tmp.2 <- exp(tmp.1)
40+
# .pmclustEnv$Z.dmat <- as.ddmatrix(tmp.2)
4141

4242
### WCC: original
43-
# tmp.id <- rowSums(.pmclustEnv$U.dmat < .pmclustEnv$CONTROL$exp.min) == K |
44-
# rowSums(.pmclustEnv$U.dmat > .pmclustEnv$CONTROL$exp.max) > 0
45-
# tmp.id <- as.vector(tmp.id)
43+
tmp.id <- rowSums(.pmclustEnv$U.dmat < .pmclustEnv$CONTROL$exp.min) == K |
44+
rowSums(.pmclustEnv$U.dmat > .pmclustEnv$CONTROL$exp.max) > 0
45+
tmp.id <- as.logical(as.vector(tmp.id))
4646
### WCC: temp dmat
47-
tmp.1 <- .pmclustEnv$U.dmat < .pmclustEnv$CONTROL$exp.min
48-
tmp.1 <- as.matrix(tmp.1)
49-
tmp.2 <- rowSums(tmp.1)
50-
tmp.3 <- tmp.2 == K
51-
tmp.4 <- .pmclustEnv$U.dmat > .pmclustEnv$CONTROL$exp.max
52-
tmp.4 <- as.matrix(tmp.4)
53-
tmp.5 <- rowSums(tmp.4)
54-
tmp.6 <- tmp.5 > 0
55-
tmp.7 <- tmp.3 | tmp.6
56-
tmp.8 <- as.vector(tmp.7)
57-
tmp.id <- tmp.8
58-
### WCC: bug
59-
# comm.print(str(tmp.id), all.rank = TRUE)
60-
tmp.id <- as.logical(tmp.id)
47+
# tmp.1 <- .pmclustEnv$U.dmat < .pmclustEnv$CONTROL$exp.min
48+
# tmp.1 <- as.matrix(tmp.1)
49+
# tmp.2 <- rowSums(tmp.1)
50+
# tmp.3 <- tmp.2 == K
51+
# tmp.4 <- .pmclustEnv$U.dmat > .pmclustEnv$CONTROL$exp.max
52+
# tmp.4 <- as.matrix(tmp.4)
53+
# tmp.5 <- rowSums(tmp.4)
54+
# tmp.6 <- tmp.5 > 0
55+
# tmp.7 <- tmp.3 | tmp.6
56+
# tmp.8 <- as.vector(tmp.7)
57+
# tmp.id <- tmp.8
58+
# tmp.id <- as.logical(tmp.id)
6159

6260
tmp.flag <- sum(tmp.id)
6361
if(tmp.flag > 0){
6462
### WCC: original
65-
# tmp.dmat <- .pmclustEnv$U.dmat[tmp.id,]
66-
### WCC: temp dmat
67-
# tmp.1 <- .pmclustEnv$U.dmat[tmp.id,]
68-
# tmp.dmat <- tmp.1
63+
tmp.dmat <- .pmclustEnv$U.dmat[tmp.id,]
6964
### WCC: temp spmd
70-
tmp.1 <- as.matrix(.pmclustEnv$U.dmat)
71-
tmp.2 <- tmp.1[tmp.id,]
72-
if(tmp.flag == 1){
73-
tmp.2 <- matrix(tmp.2, nrow = 1)
74-
}
75-
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)
7671

7772
if(tmp.flag == 1){
7873
### WCC: original
79-
# tmp.scale <- max(tmp.dmat) - .pmclustEnv$CONTROL$exp.max / K
80-
# tmp.scale <- as.vector(tmp.scale)
74+
tmp.scale <- max(tmp.dmat) - .pmclustEnv$CONTROL$exp.max / K
75+
tmp.scale <- as.vector(tmp.scale)
8176
### WCC: temp dmat
8277
# tmp.1 <- max(tmp.dmat)
8378
# tmp.2 <- tmp.1 - .pmclustEnv$CONTROL$exp.max / K
8479
# tmp.3 <- as.vector(tmp.2)
8580
# tmp.scale <- tmp.3
8681
### WCC: temp spmd
87-
tmp.1 <- as.matrix(tmp.dmat)
88-
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
8984
} else{
9085
### WCC: original
91-
# tmp.scale <- apply(tmp.dmat, 1, max) - .pmclustEnv$CONTROL$exp.max / K
92-
# 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)
9388
### WCC: temp dmat
9489
# tmp.1 <- apply(tmp.dmat, 1, max)
9590
# tmp.2 <- tmp.1 - .pmclustEnv$CONTROL$exp.max / K
9691
# tmp.3 <- as.vector(tmp.2)
9792
# tmp.scale <- tmp.3
9893
### WCC: temp spmd
99-
tmp.1 <- as.matrix(tmp.dmat)
100-
tmp.scale <- unlist(apply(tmp.1, 1, max)) -
101-
.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
10297
}
10398
### WCC: original
104-
# .pmclustEnv$Z.dmat[tmp.id,] <- exp(tmp.dmat - tmp.scale)
99+
.pmclustEnv$Z.dmat[tmp.id,] <- exp(tmp.dmat - tmp.scale)
105100
### WCC: temp dmat
106101
# tmp.1 <- exp(tmp.dmat - tmp.scale)
102+
# .pmclustEnv$Z.dmat[tmp.id,] <- tmp.1
103+
### WCC: temp spmd
107104
# tmp.1 <- as.matrix(tmp.dmat)
108105
# tmp.1 <- exp(tmp.1 - tmp.scale)
109-
110-
### WCC: bug
111106
# tmp.id <- which(tmp.id)
112-
# .pmclustEnv$Z.dmat[tmp.id,] <- tmp.1
113-
114-
### To DMS
115-
# comm.print(tmp.id)
116-
# a <- as.matrix(tmp.1)
117-
# comm.print(head(a))
118-
# b <- as.matrix(.pmclustEnv$Z.dmat)
119-
# comm.print(b[tmp.id,])
120-
# c <- as.matrix(rowSums(.pmclustEnv$Z.dmat))
121-
# comm.print(c[tmp.id])
122-
123-
### WCC: fix spmd
124-
Z.dmat <- as.matrix(.pmclustEnv$Z.dmat)
125-
Z.dmat[tmp.id,] <- as.matrix(tmp.1)
126-
.pmclustEnv$Z.dmat <- as.ddmatrix(Z.dmat)
107+
# tmp.2 <- as.matrix(.pmclustEnv$Z.dmat)
108+
# tmp.2[tmp.id,] <- tmp.1
109+
# .pmclustEnv$Z.dmat <- as.ddmatrix(Z.dmat)
127110
}
128111

129112
### WCC: original
130-
# .pmclustEnv$W.rowSums <- as.vector(rowSums(.pmclustEnv$Z.dmat))
113+
.pmclustEnv$W.rowSums <- as.vector(rowSums(.pmclustEnv$Z.dmat))
131114
### WCC: temp dmat
132115
# tmp.1 <- rowSums(.pmclustEnv$Z.dmat)
133116
# tmp.2 <- as.vector(tmp.1)
134117
# .pmclustEnv$W.rowSums <- tmp.2
135118
### WCC: temp spmd
136-
tmp.1 <- as.matrix(.pmclustEnv$Z.dmat)
137-
.pmclustEnv$W.rowSums <- rowSums(tmp.1)
119+
# tmp.1 <- as.matrix(.pmclustEnv$Z.dmat)
120+
# .pmclustEnv$W.rowSums <- rowSums(tmp.1)
138121

139122
### WCC: original
140123
# .pmclustEnv$Z.dmat <- .pmclustEnv$Z.dmat / .pmclustEnv$W.rowSums
141-
### WCC: temp dmat
142-
143-
144-
### bug
145-
# tmp.1 <- .pmclustEnv$Z.dmat / .pmclustEnv$W.rowSums
146-
# .pmclustEnv$Z.dmat <- tmp.1
147-
#a <- as.matrix(tmp.1)
148-
#comm.print(head(a))
149-
150-
### WCC: fix spmd
124+
### WCC: temp spmd
151125
tmp.1 <- as.matrix(.pmclustEnv$Z.dmat)
152126
tmp.2 <- tmp.1 / .pmclustEnv$W.rowSums
153127
.pmclustEnv$Z.dmat <- as.ddmatrix(tmp.2)
154-
#comm.print(head(tmp.2))
155128

156129

157130
### For semi-supervised clustering.
@@ -160,18 +133,18 @@ update.expectation.dmat <- function(PARAM, update.logL = TRUE){
160133
# }
161134

162135
### WCC: original
163-
# .pmclustEnv$Z.colSums <- as.vector(colSums(.pmclustEnv$Z.dmat))
136+
.pmclustEnv$Z.colSums <- as.vector(colSums(.pmclustEnv$Z.dmat))
164137
### WCC: temp dmat
165138
# tmp.1 <- colSums(.pmclustEnv$Z.dmat)
166139
# tmp.2 <- as.vector(tmp.1)
167140
# .pmclustEnv$Z.colSums <- tmp.2
168141
### WCC: temp spmd
169-
tmp.1 <- as.matrix(.pmclustEnv$Z.dmat)
170-
.pmclustEnv$Z.colSums <- colSums(tmp.1)
142+
# tmp.1 <- as.matrix(.pmclustEnv$Z.dmat)
143+
# .pmclustEnv$Z.colSums <- colSums(tmp.1)
171144

172145
if(update.logL){
173146
.pmclustEnv$W.rowSums <- log(.pmclustEnv$W.rowSums)
174-
if(tmp.flag){
147+
if(tmp.flag > 0){
175148
.pmclustEnv$W.rowSums[tmp.id] <-
176149
.pmclustEnv$W.rowSums[tmp.id] + tmp.scale
177150
}
@@ -193,6 +166,18 @@ m.step.dmat <- function(PARAM){
193166
p <- PARAM$p
194167
p.2 <- p * p
195168
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+
196181
### MLE for MU
197182
### WCC: original
198183
# B <- colSums(X.dmat * as.vector(.pmclustEnv$Z.dmat[, i.k])) /
@@ -366,15 +351,15 @@ comm.print("em.onestep.dmat logL")
366351
### Obtain classifications.
367352
em.update.class.dmat <- function(){
368353
### WCC: original
369-
# .pmclustEnv$CLASS.dmat <- apply(.pmclustEnv$Z.dmat, 1, which.max)
354+
.pmclustEnv$CLASS.dmat <- apply(.pmclustEnv$Z.dmat, 1, which.max)
370355
### WCC: temp dmat
371356
# tmp.1 <- apply(.pmclustEnv$Z.dmat, 1, which.max)
372357
# .pmclustEnv$CLASS.dmat <- tmp.1
373358
### WCC: temp spmd
374-
tmp.1 <- as.matrix(.pmclustEnv$Z.dmat)
375-
tmp.2 <- matrix(apply(tmp.1, 1, which.max), ncol = 1)
376-
tmp.3 <- as.ddmatrix(tmp.2)
377-
.pmclustEnv$CLASS.dmat <- tmp.3
359+
# tmp.1 <- as.matrix(.pmclustEnv$Z.dmat)
360+
# tmp.2 <- matrix(apply(tmp.1, 1, which.max), ncol = 1)
361+
# tmp.3 <- as.ddmatrix(tmp.2)
362+
# .pmclustEnv$CLASS.dmat <- tmp.3
378363

379364
invisible()
380365
} # End of em.update.class.dmat().

‎R/dmat_em_initial.r‎

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -12,8 +12,6 @@ initial.em.dmat <- function(PARAM, MU = NULL){
1212
if(is.null(MU)){
1313
N <- nrow(X.dmat)
1414
id <- spmd.bcast.integer(as.integer(sample(1:N, PARAM$K)))
15-
### WCC: fake
16-
#id <- c(1, 51, 101) + 20
1715
PARAM$MU <- t(as.matrix(X.dmat[id, ]))
1816
} else{
1917
PARAM$MU <- MU

‎R/dmat_my_tools.r‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -31,7 +31,7 @@ set.global.dmat <- function(K = 2, X.dmat = NULL, PARAM = NULL,
3131
U.check = rep(TRUE, K),
3232
logL = NULL,
3333
min.N.CLASS = min(c((p + 1) * p * 0.5 + 1, N / K * 0.2)))
34-
PARAM$ETA <- rep(1/K, K)
34+
PARAM$ETA <- rep(1 / K, K)
3535
PARAM$log.ETA <- rep(-log(K), K)
3636
PARAM$MU <- matrix(0, p, K)
3737
PARAM$SIGMA <- rep(list(diag(1.0, p)), K)

‎R/pm_apecm_base.r‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -100,7 +100,7 @@ ape.update.expectation.k <- function(PARAM, i.k, update.logL = TRUE){
100100

101101
if(update.logL){
102102
.pmclustEnv$W.spmd.rowSums <- log(.pmclustEnv$W.spmd.rowSums)
103-
if(tmp.flag){
103+
if(tmp.flag > 0){
104104
.pmclustEnv$W.spmd.rowSums[tmp.id] <- .pmclustEnv$W.spmd.rowSums[tmp.id] +
105105
tmp.scale
106106
}

‎R/pm_em_base.r‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -52,7 +52,7 @@ update.expectation <- function(PARAM, update.logL = TRUE){
5252

5353
if(update.logL){
5454
.pmclustEnv$W.spmd.rowSums <- log(.pmclustEnv$W.spmd.rowSums)
55-
if(tmp.flag){
55+
if(tmp.flag > 0){
5656
.pmclustEnv$W.spmd.rowSums[tmp.id] <- .pmclustEnv$W.spmd.rowSums[tmp.id] +
5757
tmp.scale
5858
}

0 commit comments

Comments
 (0)