Cardiotocographic measurements from healthy, suspect and pathological foetuses.

library(ks)
library(colorspace)
library(RColorBrewer)

## colour function
pt.col <- function(pos=1, alpha=1, ...) {return(paste0(brewer.pal(12, "Paired"), format(as.hexmode(round(alpha*255,0)), width=2))[pos])}

## plot parameters
par(oma=c(0,0,0,0)+0.1, mgp=c(1.8,0.5,0), mar=c(2.9,2.9,0,0)+0.1, cex.axis=1.2, cex.lab=1.2)
xlim <- c(0,100)
ylim <- c(70,190)
xlab <- "Abnormal short term variability (%)"
ylab <- "Cardiotocographic histogram mean"

## prepare data 
data(cardio)
set.seed(8192)
cardio.train.ind <- sample(1:nrow(cardio), round(nrow(cardio)/4,0))
cardio.test.ind <- setdiff(1:nrow(cardio), cardio.train.ind)
cardio.label.true <- cardio[,23]

cardio <- cardio[,c(8,18)]
cardio.train <- cardio[cardio.train.ind,]
cardio.train.lab <- cardio.label.true[cardio.train.ind]
cardio.test <- cardio[cardio.test.ind,]
cardio.test.lab <- cardio.label.true[cardio.test.ind]

## Fig 1.5a
## training data scatter plot
fhat.cardio <- kde(x=cardio.train)

plot(fhat.cardio, cont=0, asp=1, xaxs="i", yaxs="i", xlim=xlim, ylim=ylim, xlab=xlab, ylab=ylab)
points(cardio.train, cex=1, pch=16, col=pt.col(c(4,8,10),alpha=0.5)[cardio.train.lab])

## Fig 1.5b
## test data scatter plot
plot(fhat.cardio, cont=0, asp=1, xaxs="i", yaxs="i", xlim=xlim, ylim=ylim, xlab=xlab, ylab=ylab)
points(cardio.test, cex=1, pch=16, col=pt.col(4,alpha=0.5))

## Fig 7.4a
## kernel classification partition 
kda.cardio <- kda(x=cardio.train, x.gr=cardio.train.lab)

plot(kda.cardio, cont=0, col.part=pt.col(c(4,8,10),alpha=0.3), asp=1, xaxs="i", yaxs="i", xlim=xlim, ylim=ylim, xlab=xlab, ylab=ylab)

## Fig 7.4b
## kernel classification on test data
cardio.test.lab.est <- predict(kda.cardio, x=cardio.test)

plot(fhat.cardio, cont=0, asp=1, xaxs="i", yaxs="i", xlim=xlim, ylim=ylim, xlab=xlab, ylab=ylab)
points(cardio.test, cex=1, pch=16, col=pt.col(c(4,8,10),alpha=0.5)[cardio.test.lab.est])