demo/utility.R

# SPECIFY MODEL PARAMETERS

set.seed(1234)

n.seq <- 100
p <- 15
K <- 3
mix.prop <- c(0.25, 0.35, 0.40)

TP1 <- matrix(c(0.30, 0.01, 0.03, 0.03, 0.10, 0.15, 0.10, 0.05, 0.05, 0.05, 0.02, 0.02, 0.05, 0.02, 0.02,
		0.01, 0.30, 0.05, 0.05, 0.05, 0.10, 0.10, 0.07, 0.07, 0.07, 0.03, 0.03, 0.01, 0.03, 0.03,
		0.05, 0.05, 0.20, 0.20, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.02, 0.02, 0.12, 0.02, 0.02,
		0.05, 0.05, 0.20, 0.20, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.02, 0.02, 0.12, 0.02, 0.02,
		0.02, 0.05, 0.10, 0.10, 0.40, 0.05, 0.05, 0.02, 0.02, 0.02, 0.04, 0.04, 0.01, 0.04, 0.04,
		0.02, 0.02, 0.01, 0.01, 0.02, 0.35, 0.01, 0.05, 0.05, 0.05, 0.10, 0.10, 0.01, 0.10, 0.10,
		0.03, 0.05, 0.10, 0.10, 0.05, 0.05, 0.15, 0.02, 0.02, 0.02, 0.10, 0.10, 0.01, 0.10, 0.10,
		0.05, 0.10, 0.05, 0.05, 0.10, 0.02, 0.05, 0.15, 0.15, 0.15, 0.03, 0.03, 0.01, 0.03, 0.03,
		0.05, 0.10, 0.05, 0.05, 0.10, 0.02, 0.05, 0.15, 0.15, 0.15, 0.03, 0.03, 0.01, 0.03, 0.03,
		0.05, 0.10, 0.05, 0.05, 0.10, 0.02, 0.05, 0.15, 0.15, 0.15, 0.03, 0.03, 0.01, 0.03, 0.03,
		0.10, 0.05, 0.05, 0.05, 0.10, 0.03, 0.05, 0.05, 0.05, 0.05, 0.10, 0.10, 0.02, 0.10, 0.10,
		0.10, 0.05, 0.05, 0.05, 0.10, 0.03, 0.05, 0.05, 0.05, 0.05, 0.10, 0.10, 0.02, 0.10, 0.10,
		0.03, 0.01, 0.15, 0.15, 0.01, 0.10, 0.05, 0.10, 0.10, 0.10, 0.03, 0.03, 0.08, 0.03, 0.03,
		0.10, 0.05, 0.05, 0.05, 0.10, 0.03, 0.05, 0.05, 0.05, 0.05, 0.10, 0.10, 0.02, 0.10, 0.10,
		0.10, 0.05, 0.05, 0.05, 0.10, 0.03, 0.05, 0.05, 0.05, 0.05, 0.10, 0.10, 0.02, 0.10, 0.10), byrow = T, ncol = p)

TP2 <- matrix(c(0.01, 0.01, 0.03, 0.03, 0.10, 0.05, 0.10, 0.05, 0.05, 0.05, 0.12, 0.12, 0.04, 0.12, 0.12,
		0.01, 0.05, 0.05, 0.05, 0.05, 0.10, 0.10, 0.16, 0.16, 0.16, 0.02, 0.02, 0.03, 0.02, 0.02,
		0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.15, 0.15, 0.15, 0.03, 0.03, 0.08, 0.03, 0.03,
		0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.15, 0.15, 0.15, 0.03, 0.03, 0.08, 0.03, 0.03,
		0.10, 0.05, 0.10, 0.10, 0.10, 0.05, 0.05, 0.04, 0.04, 0.04, 0.05, 0.05, 0.13, 0.05, 0.05,
		0.02, 0.02, 0.01, 0.01, 0.02, 0.05, 0.02, 0.05, 0.05, 0.05, 0.10, 0.10, 0.30, 0.10, 0.10,
		0.13, 0.02, 0.10, 0.10, 0.05, 0.05, 0.10, 0.03, 0.03, 0.03, 0.05, 0.05, 0.16, 0.05, 0.05,
		0.11, 0.01, 0.05, 0.05, 0.03, 0.02, 0.03, 0.05, 0.05, 0.05, 0.10, 0.10, 0.15, 0.10, 0.10,
		0.11, 0.01, 0.05, 0.05, 0.03, 0.02, 0.03, 0.05, 0.05, 0.05, 0.10, 0.10, 0.15, 0.10, 0.10,
		0.11, 0.01, 0.05, 0.05, 0.03, 0.02, 0.03, 0.05, 0.05, 0.05, 0.10, 0.10, 0.15, 0.10, 0.10,
		0.10, 0.05, 0.05, 0.05, 0.10, 0.15, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.10, 0.05, 0.05,
		0.10, 0.05, 0.05, 0.05, 0.10, 0.15, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.10, 0.05, 0.05,
		0.06, 0.01, 0.15, 0.15, 0.01, 0.10, 0.05, 0.10, 0.10, 0.10, 0.03, 0.03, 0.05, 0.03, 0.03,
		0.10, 0.05, 0.05, 0.05, 0.10, 0.15, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.10, 0.05, 0.05,
		0.10, 0.05, 0.05, 0.05, 0.10, 0.15, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.10, 0.05, 0.05), byrow = T, ncol = p)

TP3 <- matrix(c(0.10, 0.10, 0.05, 0.05, 0.10, 0.10, 0.10, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05,
		0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.10, 0.10, 0.10, 0.10, 0.05, 0.05, 0.10, 0.05, 0.05,
		0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.10, 0.10, 0.10, 0.10, 0.05, 0.05, 0.10, 0.05, 0.05,
		0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.10, 0.10, 0.10, 0.10, 0.05, 0.05, 0.10, 0.05, 0.05,
		0.05, 0.05, 0.05, 0.05, 0.04, 0.05, 0.05, 0.04, 0.04, 0.04, 0.01, 0.01, 0.50, 0.01, 0.01,
		0.02, 0.04, 0.05, 0.05, 0.12, 0.05, 0.02, 0.05, 0.05, 0.05, 0.10, 0.10, 0.10, 0.10, 0.10,
		0.15, 0.10, 0.10, 0.10, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05,
		0.05, 0.01, 0.07, 0.07, 0.02, 0.03, 0.10, 0.05, 0.05, 0.05, 0.10, 0.10, 0.10, 0.10, 0.10,
		0.05, 0.01, 0.07, 0.07, 0.02, 0.03, 0.10, 0.05, 0.05, 0.05, 0.10, 0.10, 0.10, 0.10, 0.10,
		0.05, 0.01, 0.07, 0.07, 0.02, 0.03, 0.10, 0.05, 0.05, 0.05, 0.10, 0.10, 0.10, 0.10, 0.10,
		0.04, 0.15, 0.03, 0.03, 0.05, 0.10, 0.05, 0.05, 0.05, 0.05, 0.07, 0.07, 0.12, 0.07, 0.07,
		0.04, 0.15, 0.03, 0.03, 0.05, 0.10, 0.05, 0.05, 0.05, 0.05, 0.07, 0.07, 0.12, 0.07, 0.07,
		0.02, 0.03, 0.05, 0.05, 0.60, 0.01, 0.04, 0.03, 0.03, 0.03, 0.02, 0.02, 0.03, 0.02, 0.02,
		0.04, 0.15, 0.03, 0.03, 0.05, 0.10, 0.05, 0.05, 0.05, 0.05, 0.07, 0.07, 0.12, 0.07, 0.07,
		0.04, 0.15, 0.03, 0.03, 0.05, 0.10, 0.05, 0.05, 0.05, 0.05, 0.07, 0.07, 0.12, 0.07, 0.07), byrow = T, ncol = p)

TP <- array(rep(NA, p * p * K), c(p, p, K))
TP[,,1] <- TP1
TP[,,2] <- TP2
TP[,,3] <- TP3

# DATA SIMULATION

A <- click.sim(n = n.seq, int = c(10, 100), alpha = mix.prop, gamma = TP)
C <- click.read(A$S)

# DATA ANALYSIS USING THE NAIVE APPROACH (with beta's)

M1 <- click.EM(X = C$X, y = C$y, K = 1)
M2 <- click.EM(X = C$X, y = C$y, K = 2)
M3 <- click.EM(X = C$X, y = C$y, K = 3)
M4 <- click.EM(X = C$X, y = C$y, K = 4)
M5 <- click.EM(X = C$X, y = C$y, K = 5)

# DATA ANALYSIS USING THE NAIVE APPROACH (without beta's)

N1 <- click.EM(X = C$X, K = 1)
N2 <- click.EM(X = C$X, K = 2)
N3 <- click.EM(X = C$X, K = 3)
N4 <- click.EM(X = C$X, K = 4)
N5 <- click.EM(X = C$X, K = 5)

# DATA ANALYSIS USING FORWARD STATE SEARCH

F1 <- click.forward(C$X, K = 1)
F2 <- click.forward(C$X, K = 2)
F3 <- click.forward(C$X, K = 3)
F4 <- click.forward(C$X, K = 4)
F5 <- click.forward(C$X, K = 5)

# DATA ANALYSIS USING BACKWARD STATE SEARCH

B1 <- click.backward(C$X, K = 1)
B2 <- click.backward(C$X, K = 2)
B3 <- click.backward(C$X, K = 3)
B4 <- click.backward(C$X, K = 4)
B5 <- click.backward(C$X, K = 5)

rbind(c(M1$BIC, M2$BIC, M3$BIC, M4$BIC, M5$BIC),
      c(N1$BIC, N2$BIC, N3$BIC, N4$BIC, N5$BIC),
      c(F1$BIC, F2$BIC, F3$BIC, F4$BIC, F5$BIC),
      c(B1$BIC, B2$BIC, B3$BIC, B4$BIC, B5$BIC))

click.plot(X = C$X, id = B3$id, colors = c("lightyellow", "red", "darkred"), col.levels = 10)

Try the ClickClust package in your browser

Any scripts or data that you put into this service are public.

ClickClust documentation built on June 22, 2024, 12:23 p.m.