archetypes.R
In archetypes: Archetypal Analysis

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

###################################################
### code chunk number 1: archetypes.Rnw:70-71
###################################################
options(width=80, prompt='R> ')


###################################################
### code chunk number 2: archetypes.Rnw:298-299
###################################################
library(archetypes)


###################################################
### code chunk number 3: archetypes.Rnw:322-324 (eval = FALSE)
###################################################
## data("toy")
## plot(toy)


###################################################
### code chunk number 4: archetypes.Rnw:329-334
###################################################
data("toy")

par(mar = c(2,2,0,0) + 0.1, ps = 9)
plot(toy, xlab = "", ylab = "", xlim = c(0,20), ylim = c(0,20),
     pch = 19, col = gray(0.7), cex = 0.6)


###################################################
### code chunk number 5: archetypes.Rnw:343-346
###################################################
suppressWarnings(RNGversion("3.5.0"))
set.seed(1986)
a <- archetypes(toy, 3, verbose = TRUE)


###################################################
### code chunk number 6: archetypes.Rnw:357-358
###################################################
a


###################################################
### code chunk number 7: archetypes.Rnw:361-362
###################################################
parameters(a)


###################################################
### code chunk number 8: archetypes.Rnw:368-370 (eval = FALSE)
###################################################
## xyplot(a, toy, chull = chull(toy))
## xyplot(a, toy, adata.show = TRUE)


###################################################
### code chunk number 9: archetypes.Rnw:375-380
###################################################
par(mfrow = c(1,2), mar = c(2,2,0,0)+0.1, ps = 9)
xyplot(a, toy, chull = chull(toy),
       xlab = "", ylab = "", xlim = c(0, 20), ylim = c(0, 20), cex = 0.6)
xyplot(a, toy, adata.show = TRUE,
       xlab = "", ylab = "", xlim = c(0, 20), ylim = c(0, 20), cex = 0.6)


###################################################
### code chunk number 10: archetypes.Rnw:400-401 (eval = FALSE)
###################################################
## movieplot(a, toy)


###################################################
### code chunk number 11: archetypes.Rnw:406-412
###################################################
par(mfrow = c(2, 4), mar = c(0, 0, 0, 0) + 0.1, ps = 9)
movieplot(a, toy, xlim = c(0, 20), ylim = c(0, 20), cex = 0.6, axes = FALSE,
          postfn = function(iter) {
            box()
            text(1, 19, paste(iter + 1, ".", sep = ""), cex = 1)
          })


###################################################
### code chunk number 12: archetypes.Rnw:431-433
###################################################
set.seed(1986)
a4 <- stepArchetypes(data = toy, k = 3, verbose = FALSE, nrep = 4)


###################################################
### code chunk number 13: archetypes.Rnw:436-437
###################################################
a4


###################################################
### code chunk number 14: archetypes.Rnw:441-442
###################################################
summary(a4)


###################################################
### code chunk number 15: archetypes.Rnw:448-449 (eval = FALSE)
###################################################
## xyplot(a4, toy)


###################################################
### code chunk number 16: archetypes.Rnw:454-457
###################################################
par(mar = c(2, 2, 0, 0) + 0.1, ps = 9)
xyplot(a4, toy, cex = 0.6, xlim = c(0, 20), ylim = c(0, 20),
       xlab = "", ylab = "")


###################################################
### code chunk number 17: archetypes.Rnw:464-465 (eval = FALSE)
###################################################
## bestModel(a4)


###################################################
### code chunk number 18: archetypes.Rnw:467-468
###################################################
print(bestModel(a4), full = FALSE)


###################################################
### code chunk number 19: archetypes.Rnw:481-489
###################################################
file <- "as.RData"
if ( file.exists(file) ) {
  load(file = file)
} else {
  set.seed(1986)
  as <- stepArchetypes(data = toy, k = 1:10, verbose = FALSE, nrep = 4)
  save(as, file = file)
}


###################################################
### code chunk number 20: archetypes.Rnw:519-520
###################################################
rss(as)


###################################################
### code chunk number 21: archetypes.Rnw:523-524
###################################################
t(sapply(as, function(a) sapply(a, '[[', 'iters')))


###################################################
### code chunk number 22: archetypes.Rnw:535-536 (eval = FALSE)
###################################################
## screeplot(as)


###################################################
### code chunk number 23: archetypes.Rnw:541-546
###################################################
par(mar = c(3, 4, 0.1, 0) + 0.1, ps = 9)
screeplot(as, cex = 0.6, ylim = c(0, 0.08), axes = FALSE)
mtext("Archetypes", side = 1, line = 2)
axis(2, las = 2)
box()


###################################################
### code chunk number 24: archetypes.Rnw:554-557 (eval = FALSE)
###################################################
## a7 <- bestModel(as[[7]])
## xyplot(a7, toy, chull = chull(toy))
## xyplot(a7, toy, adata.show = TRUE)


###################################################
### code chunk number 25: archetypes.Rnw:562-569
###################################################
a7 <- bestModel(as[[7]])

par(mfrow = c(1, 2), mar = c(2, 2, 0, 0) + 0.1, ps = 9)
xyplot(a7, toy, chull = chull(toy),
       xlim = c(0, 20), ylim = c(0, 20), cex = 0.6, xlab = "", ylab = "")
xyplot(a7, toy, adata.show = TRUE,
       xlim = c(0, 20), ylim = c(0, 20), cex = 0.6, xlab = "", ylab = "")


###################################################
### code chunk number 26: archetypes.Rnw:583-594
###################################################
file <- "gas.RData"
if ( file.exists(file) ) {
  load(file = file)
} else {
  set.seed(1986)
  gas <- stepArchetypes(data = toy, k = 1:10,
                        family = archetypesFamily("original",
                        zalphasfn = archetypes:::ginv.zalphasfn),
                        verbose = FALSE, nrep = 4)
  save(gas, file = file)
}


###################################################
### code chunk number 27: archetypes.Rnw:633-634
###################################################
rss(gas)


###################################################
### code chunk number 28: archetypes.Rnw:638-639 (eval = FALSE)
###################################################
## movieplot(gas[[9]][[3]], toy)


###################################################
### code chunk number 29: archetypes.Rnw:644-650
###################################################
par(mfrow = c(1, 4), mar = c(0, 0, 0, 0) + 0.1, ps = 9)
movieplot(gas[[9]][[3]], toy, xlim = c(0, 20), ylim = c(0, 20), cex = 0.6,
          axes = FALSE, postfn = function(iter) {
            box()
            text(1, 19, paste(iter + 1, ".", sep = ""), cex = 1)
          })


###################################################
### code chunk number 30: archetypes.Rnw:668-671 (eval = FALSE)
###################################################
## ga7 <- bestModel(gas[[7]])
## xyplot(ga7, toy, chull = chull(toy))
## xyplot(ga7, toy, adata.show = TRUE)


###################################################
### code chunk number 31: archetypes.Rnw:676-683
###################################################
ga7 <- bestModel(gas[[7]])

par(mfrow = c(1, 2), mar = c(2, 2, 0, 0) + 0.1, ps = 9)
xyplot(ga7, toy, chull = chull(toy),
       xlim = c(0, 20), ylim = c(0, 20), cex = 0.6, xlab = "", ylab = "")
xyplot(ga7, toy, adata.show = TRUE,
       xlim = c(0, 20), ylim = c(0, 20), cex = 0.6, xlab = "", ylab = "")


###################################################
### code chunk number 32: archetypes.Rnw:693-694
###################################################
apply(coef(ga7, 'alphas'), 2, range)


###################################################
### code chunk number 33: archetypes.Rnw:796-798
###################################################
data("skel")
skel2 <- subset(skel, select = -Gender)


###################################################
### code chunk number 34: archetypes.Rnw:817-818 (eval = FALSE)
###################################################
## jd()


###################################################
### code chunk number 35: archetypes.Rnw:823-825
###################################################
par(mar = c(1, 4, 0, 0) + 0.1, ps = 9)
jd()


###################################################
### code chunk number 36: archetypes.Rnw:833-834 (eval = FALSE)
###################################################
## pcplot(skel2)


###################################################
### code chunk number 37: archetypes.Rnw:839-841
###################################################
datacol <- rgb(178, 178, 178, maxColorValue = 255,
               alpha = round(255 * 0.2))


###################################################
### code chunk number 38: archetypes.Rnw:843-845 (eval = FALSE)
###################################################
## par(mar = c(5, 0.4, 0, 0.4) + 0.1, ps = 9)
## pcplot(skel2, las = 2, col = datacol)


###################################################
### code chunk number 39: archetypes.Rnw:847-853
###################################################
png(filename = "body-pcplot-raw.png", units = "px",
    width = 590, height = 430, pointsize = 12)
par(mar = c(5.5, 0.4, 0, 0.4) + 0.1)
pcplot(skel2, las = 2, col = datacol)
graphics.off()
cat("\\includegraphics{body-pcplot-raw.png}\n")


###################################################
### code chunk number 40: archetypes.Rnw:862-870
###################################################
file <- "bas.RData"
if ( file.exists(file) ) {
  load(file = file)
} else {
  set.seed(1981)
  as <- stepArchetypes(skel2, k = 1:15, verbose = FALSE)
  save(as, file = file)
}


###################################################
### code chunk number 41: archetypes.Rnw:885-886 (eval = FALSE)
###################################################
## screeplot(as)


###################################################
### code chunk number 42: archetypes.Rnw:891-896
###################################################
par(mar = c(3, 4, 0.4, 0) + 0.1, ps = 9)
screeplot(as, cex = 0.6, axes = FALSE)
mtext("Archetypes", side = 1, line = 2)
axis(2, las = 2)
box()


###################################################
### code chunk number 43: archetypes.Rnw:904-905
###################################################
a3 <- bestModel(as[[3]])


###################################################
### code chunk number 44: archetypes.Rnw:908-909
###################################################
t(parameters(a3))


###################################################
### code chunk number 45: archetypes.Rnw:912-913 (eval = FALSE)
###################################################
## barplot(a3, skel2, percentiles = TRUE)


###################################################
### code chunk number 46: archetypes.Rnw:918-922
###################################################
par(mar = c(5, 4, 0.4, 0) + 0.1, ps = 9)
barplot(a3, skel2, percentiles = TRUE,
        below.compressed.height = 0.4,
        below.compressed.srt = 90)


###################################################
### code chunk number 47: archetypes.Rnw:934-935 (eval = FALSE)
###################################################
## pcplot(a3, skel2, data.col = as.numeric(skel$Gender))


###################################################
### code chunk number 48: archetypes.Rnw:940-944
###################################################
datacol <- c(rgb(0, 205, 0, maxColorValue = 255,
                 alpha = round(255 * 0.2)),
             rgb(0, 0, 255, maxColorValue = 255,
                 alpha=round(255 * 0.2)))


###################################################
### code chunk number 49: archetypes.Rnw:946-948 (eval = FALSE)
###################################################
## par(mar = c(5, 0.4, 0, 0.4) + 0.1, ps = 9)
## pcplot(a3, skel2, las = 2, data.col = datacol[skel$Gender])


###################################################
### code chunk number 50: archetypes.Rnw:950-956
###################################################
png(filename = "body-pcplot-gender.png", units = "px",
    width = 590, height = 430, pointsize = 12)
par(mar = c(5.5, 0.4, 0, 0.4) + 0.1)
pcplot(a3, skel2, las = 2, data.col = datacol[skel$Gender])
graphics.off()
cat("\\includegraphics{body-pcplot-gender.png}\n")


###################################################
### code chunk number 51: archetypes.Rnw:969-970 (eval = FALSE)
###################################################
## ternaryplot(coef(a3, 'alphas'), col = as.numeric(skel$Gender))


###################################################
### code chunk number 52: archetypes.Rnw:975-980
###################################################
library("vcd")
ternaryplot(coef(a3, 'alphas'), dimnames = 1:3, cex = 0.3,
            col = datacol[skel$Gender], main = NULL,
            labels = "none", grid = FALSE)
grid.text("1", x = 3, y = 3)


###################################################
### code chunk number 53: archetypes.Rnw:996-997 (eval = FALSE)
###################################################
## skeletonplot(parameters(a3))


###################################################
### code chunk number 54: archetypes.Rnw:1002-1004
###################################################
par(mar = c(1, 4, 0, 0) + 0.1, ps = 9)
skeletonplot(parameters(a3), skel.height = 190)


###################################################
### code chunk number 55: archetypes.Rnw:1054-1055
###################################################
sessionInfo()