According to Wikipedia, “Cushing’s syndrome is a collection of signs and symptoms due to prolonged exposure to cortisol”.
The dataframe Cushings is available in MASS.
The object is to predict type of Cushing’s syndrome, a, b, c or u, given the levels of two steroids, Pregnanetriol and Tetrahydrocortisone, present in the individual. The data may be visualized using conditional lattice scatterplots as shown in Figure 1. From this Figure we see there are clear statistical differences.
xyplot(Tetrahydrocortisone~Pregnanetriol | Type,
data=Cushings, panel=function(x,y) {
panel.xyplot(x, y, pch=19, col="blue", cex=1.07)
panel.grid(h=-1, v=-1, col=rgb(0,0,0,0.5), lty=1)
},
main="Cushings Syndrome: Types a, b, c, u")
xyplot(Tetrahydrocortisone~Pregnanetriol, cex=2, col="black",
pch=as.character(Cushings$Type), data=Cushings)
X <- Cushings[,1:2]
y <- Cushings[,3]
ansLDA <- MASS::lda(X, y)
yH <- predict(ansLDA, newdata=X)$class
(eta <- 1-mean(yH==y))
## [1] 0.4074074
(mtb <- table(y, yH))
## yH
## y a b c u
## a 0 5 1 0
## b 0 10 0 0
## c 0 1 4 0
## u 0 3 1 2
with(Cushings, plot(Tetrahydrocortisone, Pregnanetriol, cex=0.8, col="black",
pch=as.character(Cushings$Type), pty="s"))
x <- expand.grid(seq(0,55,0.03), seq(0,12,0.045))
names(x) <- names(X)
yf <- predict(ansLDA, newdata=x)$class
x <- as.matrix.data.frame(x)
title(main="Cushings Syndrome\na:red, b:blue, c:gray, u:magenta")
title(sub="LDA")
xy <- x[yf=="a",]
alpha <- 0.25
points(xy, col=rgb(1,0,0,alpha), pch=".")
xy <- x[yf=="b",]
points(xy, col=rgb(0,0,1,alpha), pch=".")
xy <- x[yf=="c",]
points(xy, col=rgb(0.5,0.5,0.5,alpha), pch=".")
xy <- x[yf=="u",]
points(xy, col=rgb(1,0,1,alpha), pch=".")
xyplot(Tetrahydrocortisone~Pregnanetriol, cex=2, col="black",
pch=as.character(Cushings$Type), data=Cushings)
X <- Cushings[,1:2]
y <- Cushings[,3]
ansMReg <- nnet::multinom(Type ~., data=Cushings)
## # weights: 16 (9 variable)
## initial value 37.429948
## iter 10 value 22.757596
## iter 20 value 18.245072
## iter 30 value 18.179351
## final value 18.179218
## converged
yH <- predict(ansMReg, newdata=X)
(eta <- 1-mean(yH==y))
## [1] 0.2592593
(mtb <- table(y, yH))
## yH
## y a b c u
## a 5 1 0 0
## b 0 9 1 0
## c 0 1 4 0
## u 1 2 1 2
with(Cushings, plot(Tetrahydrocortisone, Pregnanetriol, cex=0.8, col="black",
pch=as.character(Cushings$Type), pty="s"))
x <- expand.grid(seq(0,55,0.03), seq(0,12,0.045))
names(x) <- names(X)
yf <- predict(ansMReg, newdata=x)
x <- as.matrix.data.frame(x)
title(main="Cushings Syndrome\na:red, b:blue, c:gray, u:magenta")
title(sub="Multinomial regression")
xy <- x[yf=="a",]
alpha <- 0.25
points(xy, col=rgb(1,0,0,alpha), pch=".")
xy <- x[yf=="b",]
points(xy, col=rgb(0,0,1,alpha), pch=".")
xy <- x[yf=="c",]
points(xy, col=rgb(0.5,0.5,0.5,alpha), pch=".")
xy <- x[yf=="u",]
points(xy, col=rgb(1,0,1,alpha), pch=".")