Gen-VariScan/gen.clust.R at master · chetkar/Gen-VariScan · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
#' @keywords internal
gen.clust <- function(n, p) {

	true_parm <- NULL

	true_parm$d <- 0

	true_parm$clust <- NULL
	true_parm$clust$c.v <- array(,p)
	true_parm$clust$c.v[1] <- 1
	true_parm$clust$C.m.vec <- 1
	true_parm$clust$G <- 1
	true_parm$b0 <- 2.2
	true_parm$b1 <- 30


	for (xx in 2:p)
	{prob.v <- true_parm$clust$C.m.vec - true_parm$d
	 prob.v <- c(prob.v, (true_parm$b1 + true_parm$clust$G*true_parm$d))
	 new.c <- sample(1:(true_parm$clust$G+1), size=1, prob=prob.v)

	 true_parm$clust$c.v[xx] <- new.c
	 new.flag <- (new.c > true_parm$clust$G)

	 if (new.flag)
	 {true_parm$clust$G <- true_parm$clust$G + 1
	  true_parm$clust$C.m.vec <- c(true_parm$clust$C.m.vec, 1)
	 }
	 if (!new.flag)
	 {true_parm$clust$C.m.vec[new.c] <- true_parm$clust$C.m.vec[new.c] + 1
	 }
	}


	## neighborhood taxicab distances for column clusters

	tmp.mat <- array(0,c(p,p))

	for (jj in 1:true_parm$clust$G)
	{indx.jj <- which(true_parm$clust$c.v==jj)
	 tmp.mat[indx.jj,indx.jj] <- 1
	}

	true_parm$clust$nbhd.matrix <- tmp.mat

	#####

	true_parm$N <- n*true_parm$clust$G
	true_parm$clust$s.v <- array(,n*true_parm$clust$G)
	true_parm$clust$s.v[1] <- 1
	true_parm$clust$n.vec <- 1
	true_parm$clust$K <- 1
	true_parm$clust$M <- 11


	for (xx in 2:true_parm$N)
	{
	 prob.v <- c(true_parm$clust$n.vec)
	 prob.v <- c(prob.v, true_parm$clust$M)
	 new.s <- sample(1:(true_parm$clust$K+1), size=1, prob=prob.v)

	 true_parm$clust$s.v[xx] <- new.s
	 new.flag <- (new.s > true_parm$clust$K)

	 if (new.flag)
	 {true_parm$clust$K <- true_parm$clust$K + 1
	  true_parm$clust$n.vec <- c(true_parm$clust$n.vec, 1)
	 }

	 if ((!new.flag))
	 {true_parm$clust$n.vec[new.s] <- true_parm$clust$n.vec[new.s] + 1
	 }
	}


	true_parm$clust$s.mt <- matrix(true_parm$clust$s.v, nrow=n)

	###########

	true_parm$clust$mu2  <- 0.193035
	true_parm$clust$tau2 <- 1.179075

	true_parm$clust$phi.v <- rnorm(n=true_parm$clust$K, mean=true_parm$clust$mu2, sd=true_parm$clust$tau2)


	return (true_parm)
}