Statistics

Set up

library(logisticPCA)
library(ggplot2)
library(tidyr)
library(dplyr)
library(knitr)
setwd("~/Documents/")
stats <- read.csv("StatsChart2.csv", stringsAsFactors = FALSE)
stats$Trauma <- toupper(stats$Trauma)
statsBin <- stats[,-1*c(1:4, length(stats))]


for (i in 1:ncol(statsBin)) {
  yes <- which(statsBin[,i] == "YES")
  no  <- which(statsBin[,i] == "NO")
  statsBin[yes, i] <- 1
  statsBin[no, i]  <- 0
  statsBin[,i]     <- as.numeric(statsBin[,i])
}
statsBin <- as.matrix(statsBin)
rownames(statsBin) <- stats$Diagnosis

Summarize Data

### Stats 
stats$Dental.Spacing <- factor(stats$Dental.Spacing, levels = c("YES", "NO"))
stats$Trabecular.Pattern <- factor(stats$Trabecular.Pattern)
Totals <- aggregate(x = stats[,5:12], list(stats$Diagnosis), table, simplify = TRUE) 
Totals <- as.data.frame(as.list(Totals))
Totals.plot <- Totals %>% gather(Pattern, Total, 2:ncol(Totals))

Totals.plot$Pattern <- gsub(".NO", "_NO", Totals.plot$Pattern)
Totals.plot$Pattern <- gsub(".YES", "_YES", Totals.plot$Pattern)
Totals.plot$Pattern <- gsub(".DENSE", "_DENSE", Totals.plot$Pattern)
Totals.plot$Pattern <- gsub(".MIXED", "_MIXED", Totals.plot$Pattern)
Totals.plot$Pattern <- gsub(".SPARSE", "_SPARSE", Totals.plot$Pattern)
Totals.plot$Pattern <- gsub(".DONE", "_NONE", Totals.plot$Pattern)
Totals.plot <- Totals.plot %>% separate(Pattern, into=c("Diagnosis", "ANSWER"), sep="_")

ggplot(Totals.plot,aes(x=factor(Diagnosis),y=Total,fill=factor(ANSWER))) + 
  geom_bar(position="fill", stat="identity") +
  scale_y_continuous(labels=c("25%", "50%", '75%', "100%"),
                   breaks=c(0.25,.5,.75,1)) + # you can set the breaks to whatever you want
  facet_wrap(~ Group.1) +
  theme(axis.text.x=element_text(angle=90, hjust=1)) +
  labs(fill="ANSWER")

datatable(Totals, extensions = 'FixedColumns',
  options = list(
    dom = 't',
    scrollX = TRUE,
    fixedColumns = list(leftColumns = 2)
  )
)

Ran PCA on only binary data.

The matrix used and subsetted is the one below. This is just the first 10 lines but I subsetted your large table for this

datatable(head(statsBin), extensions = 'FixedColumns',
  options = list(
    dom = 't',
    scrollX = TRUE,
    fixedColumns = list(leftColumns = 2)
  )
)

### ALL DATA
logsvd_model = logisticSVD(statsBin, k = 4, max_iters = 2000)
logpca_cv = cv.lpca(statsBin, ks = 4, ms = 1:10)
logpca_model = logisticPCA(statsBin, k = 4, m = which.min(logpca_cv))
clogpca_model = convexLogisticPCA(statsBin, k = 4, m = which.min(logpca_cv))

## ALL Together
Diagnosis <- rownames(statsBin)

plot(logsvd_model, type = "scores") + 
  geom_point(aes(colour = Diagnosis)) + 
  ggtitle("Exponential Family PCA") + 
  scale_colour_manual(values = c("blue", "red", "green", "violet"))

plot(logpca_model, type = "scores") + 
  geom_point(aes(colour = Diagnosis)) + 
  ggtitle("Logistic PCA") + 
  scale_colour_manual(values = c("blue", "red", "green", "violet"))

plot(clogpca_model, type = "scores") + 
  geom_point(aes(colour = Diagnosis)) + 
  ggtitle("Convex Logistic PCA") + 
  scale_colour_manual(values = c("blue", "red", "green", "violet"))

### Factor Out Data
ID     <- which(rownames(statsBin) == "ID")
AUTISM <- which(rownames(statsBin) == "AUTISM")
DOWNS  <- which(rownames(statsBin) == "DOWNS")
CP     <- which(rownames(statsBin) == "CP")


### ID vs AUTISM
IDvAUTISM <- statsBin[c(ID, AUTISM),]

logsvd_model = logisticSVD(IDvAUTISM, k = 2, max_iters = 2000)
logpca_cv = cv.lpca(IDvAUTISM, ks = 2, ms = 1:10)

logpca_model = logisticPCA(IDvAUTISM, k = 2, m = which.min(logpca_cv))
clogpca_model = convexLogisticPCA(IDvAUTISM, k = 2, m = which.min(logpca_cv))

# plot(clogpca_model, type = "trace")
# plot(logsvd_model, type = "trace")

Diagnosis <- rownames(IDvAUTISM)

plot(logsvd_model, type = "scores") + 
  geom_point(aes(colour = Diagnosis)) + 
  ggtitle("Exponential Family PCA") + 
  scale_colour_manual(values = c("blue", "red"))

plot(logpca_model, type = "scores") + 
  geom_point(aes(colour = Diagnosis)) + 
  ggtitle("Logistic PCA") + 
  scale_colour_manual(values = c("blue", "red"))

plot(clogpca_model, type = "scores") + 
  geom_point(aes(colour = Diagnosis)) + 
  ggtitle("Convex Logistic PCA") + 
  scale_colour_manual(values = c("blue", "red"))

### ID vs DOWNS
IDvDOWNS <- statsBin[c(ID, DOWNS),]

logsvd_model = logisticSVD(IDvDOWNS, k = 2, max_iters = 2000)
logpca_cv = cv.lpca(IDvDOWNS, ks = 2, ms = 1:10)

logpca_model = logisticPCA(IDvDOWNS, k = 2, m = which.min(logpca_cv))
clogpca_model = convexLogisticPCA(IDvDOWNS, k = 2, m = which.min(logpca_cv))

# plot(clogpca_model, type = "trace")
# plot(logsvd_model, type = "trace")

Diagnosis <- rownames(IDvDOWNS)

plot(logsvd_model, type = "scores") + 
  geom_point(aes(colour = Diagnosis)) + 
  ggtitle("Exponential Family PCA") + 
  scale_colour_manual(values = c("blue", "green"))

plot(logpca_model, type = "scores") + 
  geom_point(aes(colour = Diagnosis)) + 
  ggtitle("Logistic PCA") + 
  scale_colour_manual(values = c("blue", "green"))

plot(clogpca_model, type = "scores") + 
  geom_point(aes(colour = Diagnosis)) + 
  ggtitle("Convex Logistic PCA") + 
  scale_colour_manual(values = c("blue", "green"))

### ID vs CP
IDvCP <- statsBin[c(ID, CP),]

logsvd_model = logisticSVD(IDvCP, k = 2, max_iters = 2000)
logpca_cv = cv.lpca(IDvCP, ks = 2, ms = 1:10)

logpca_model = logisticPCA(IDvCP, k = 2, m = which.min(logpca_cv))
clogpca_model = convexLogisticPCA(IDvCP, k = 2, m = which.min(logpca_cv))

# plot(clogpca_model, type = "trace")
# plot(logsvd_model, type = "trace")

Diagnosis <- rownames(IDvCP)

plot(logsvd_model, type = "scores") + 
  geom_point(aes(colour = Diagnosis)) + 
  ggtitle("Exponential Family PCA") + 
  scale_colour_manual(values = c("blue", "violet"))

plot(logpca_model, type = "scores") + 
  geom_point(aes(colour = Diagnosis)) + 
  ggtitle("Logistic PCA") + 
  scale_colour_manual(values = c("blue", "violet"))

plot(clogpca_model, type = "scores") + 
  geom_point(aes(colour = Diagnosis)) + 
  ggtitle("Convex Logistic PCA") + 
  scale_colour_manual(values = c("blue", "violet"))

### AUTISM vs DOWNS
AUTISMvDOWNS <- statsBin[c(AUTISM, DOWNS),]

logsvd_model = logisticSVD(AUTISMvDOWNS, k = 2, max_iters = 2000)
logpca_cv = cv.lpca(AUTISMvDOWNS, ks = 2, ms = 1:10)

logpca_model = logisticPCA(AUTISMvDOWNS, k = 2, m = which.min(logpca_cv))
clogpca_model = convexLogisticPCA(AUTISMvDOWNS, k = 2, m = which.min(logpca_cv))

# plot(clogpca_model, type = "trace")
# plot(logsvd_model, type = "trace")

Diagnosis <- rownames(AUTISMvDOWNS)

plot(logsvd_model, type = "scores") + 
  geom_point(aes(colour = Diagnosis)) + 
  ggtitle("Exponential Family PCA") + 
  scale_colour_manual(values = c("red", "green"))

plot(logpca_model, type = "scores") + 
  geom_point(aes(colour = Diagnosis)) + 
  ggtitle("Logistic PCA") + 
  scale_colour_manual(values = c("red", "green"))

plot(clogpca_model, type = "scores") + 
  geom_point(aes(colour = Diagnosis)) + 
  ggtitle("Convex Logistic PCA") + 
  scale_colour_manual(values = c("red", "green"))

### AUTISM vs CP
AUTISMvCP <- statsBin[c(AUTISM, CP),]

logsvd_model = logisticSVD(AUTISMvCP, k = 2, max_iters = 2000)
logpca_cv = cv.lpca(AUTISMvCP, ks = 2, ms = 1:10)

logpca_model = logisticPCA(AUTISMvCP, k = 2, m = which.min(logpca_cv))
clogpca_model = convexLogisticPCA(AUTISMvCP, k = 2, m = which.min(logpca_cv))

# plot(clogpca_model, type = "trace")
# plot(logsvd_model, type = "trace")

Diagnosis <- rownames(AUTISMvCP)

plot(logsvd_model, type = "scores") + 
  geom_point(aes(colour = Diagnosis)) + 
  ggtitle("Exponential Family PCA") + 
  scale_colour_manual(values = c("red", "violet"))

plot(logpca_model, type = "scores") + 
  geom_point(aes(colour = Diagnosis)) + 
  ggtitle("Logistic PCA") + 
  scale_colour_manual(values = c("red", "violet"))

plot(clogpca_model, type = "scores") + 
  geom_point(aes(colour = Diagnosis)) + 
  ggtitle("Convex Logistic PCA") + 
  scale_colour_manual(values = c("red", "violet"))

### DOWNS vs CP
DOWNSvCP <- statsBin[c(DOWNS, CP),]

logsvd_model = logisticSVD(DOWNSvCP, k = 2, max_iters = 2000)
logpca_cv = cv.lpca(DOWNSvCP, ks = 2, ms = 1:10)

logpca_model = logisticPCA(DOWNSvCP, k = 2, m = which.min(logpca_cv))
clogpca_model = convexLogisticPCA(DOWNSvCP, k = 2, m = which.min(logpca_cv))

# plot(clogpca_model, type = "trace")
# plot(logsvd_model, type = "trace")

Diagnosis <- rownames(DOWNSvCP)

plot(logsvd_model, type = "scores") + 
  geom_point(aes(colour = Diagnosis)) + 
  ggtitle("Exponential Family PCA") + 
  scale_colour_manual(values = c("green", "violet"))

plot(logpca_model, type = "scores") + 
  geom_point(aes(colour = Diagnosis)) + 
  ggtitle("Logistic PCA") + 
  scale_colour_manual(values = c("green", "violet"))

plot(clogpca_model, type = "scores") + 
  geom_point(aes(colour = Diagnosis)) + 
  ggtitle("Convex Logistic PCA") + 
  scale_colour_manual(values = c("green", "violet"))