inst/doc/HCsnip.R

In HCsnip: Semi-supervised adaptive-height snipping of the Hierarchical Clustering tree

### R code from vignette source 'HCsnip.Rnw'

###################################################
### code chunk number 1: chunk1
###################################################
library(HCsnip)
data(BullingerLeukemia)
names(BullingerLeukemia)


###################################################
### code chunk number 2: chunk2
###################################################
library(HCsnip)
data(TcgaGBM)
names(TcgaGBM)


###################################################
### code chunk number 3: chunk3
###################################################
data(BullingerLeukemia)
attach(BullingerLeukemia)
cl <- HCsnipper(em[, 1:30], minclus = 5)
cl <- cl$partitions[cl$id, ]
## To check returned partitions size
table(apply(cl, 1, function(x) length(unique(x))))


###################################################
### code chunk number 4: chunk4
###################################################
a <- apply(cl, 1, function(x) measure(parti = x, 
                        dis = 1 - cor(em[, 1:30]))) 


###################################################
### code chunk number 5: chunk5
###################################################
b <- apply(cl, 1, function(x) surv_measure(x, 
                     surv.time[1:30], status[1:30]))


###################################################
### code chunk number 6: chunk6
###################################################
result <- perm_test(cl, surv.time[1:30], status[1:30], score1 = a, score2 = b, 
                       nperm = 10) 


###################################################
### code chunk number 7: chunk7
###################################################
data(TcgaGBM)
em <- TcgaGBM$em
drugs <- TcgaGBM$drug
gr <- rep(1, ncol(em))
gr[drugs == "Temodar"] <- 2
H <- EnvioPlot(X = em, parti = gr, names = c("Avastin", "Temodar"), 
             col = c("blue", "red"))


###################################################
### code chunk number 8: chunk8
###################################################
data(BullingerLeukemia)
attach(BullingerLeukemia)
par(mfrow = c(1, 2))
pred <- cluster_pred(X = em[, 1:60], partition = result$best, 
              surv.time = surv.time[1:30], status = status[1:30], te.index = 31:60,
              te.surv.time = surv.time[31:60], te.status = status[31:60], plot.it = TRUE)
H <- EnvioPlot(X = em[, 31:60], parti = pred[["St"]][, 2])              


###################################################
### code chunk number 9: chunk9
###################################################
cl <- HCsnipper(em[, 1:40], minclus = 4)
cl <- cl$partitions[cl$id, ]
pred <- cluster_pred(X = em[, 1:60], partition = cl[6, ], 
              surv.time = surv.time[1:40], status = status[1:40], te.index = 41:60)
Err <- RSF_eval(cl[1, ], surv.time[1:40], status[1:40], 
               pred, surv.time[41:60], status[41:60])


###################################################
### code chunk number 10: chunk10 (eval = FALSE)
###################################################
## data(TcgaGBM)
## attach(TcgaGBM)
## id1 <- which(drugs == "Avastin")
## id2 <- which(drugs == "Temodar") 
## twoHC <- TwoHC_assign(X = em[ ,c(id1[1:30], id2[1:30])], index1 = 1:30, 
##                 index2 = 31:60, new.X = em[, c(id1[31:60], id2[31:60])], 
##                 minclus = 4, surv.time = surv.time[c(id1[1:30], id2[1:30])], 
##                 status = status[c(id1[1:30], id2[1:30])])  


###################################################
### code chunk number 11: chunk11 (eval = FALSE)
###################################################
## result <- TwoHC_perm(twoHC, nperm = 100)