# R/pm.R In SchmidtPaul/shoRtcuts: The shoRtcuts package

#### Documented in pm

```#' @title Plots matrix as a heatmap
#'
#' @descripton This function tries to give the user a quick
#' overview for any matrix he is dealing with. It does so by
#' drawing a heatmap plot and also providing additional
#' information like e.g. the most frequent values in the matrix.
#' @param M Matrix to be plotted
#' @keywords matrix heatmap
#' @details
#' @examples
#' X <- replicate(10, rnorm(10)/10)
#' diag(X) <- rep(1,10)
#' pm(X)

pm <- function(M){

# prepare data for plotting
M <- as.matrix(M)
rownames(M) <- NULL
colnames(M) <- NULL
Mm <- as.data.table(melt(M))
names(Mm) <- c("row","col","value")

## matrix name
name <- "M"
name <- bquote(atop(~ .(name)[.(dim(M)[1])~"x"~.(dim(M)[2]) ],~" "))
## matrix' unique values
unitot <- length(unique(c(M)))
uniond <- length(unique(diag(M)))
M2 <- M; diag(M2) <- NA
uniofd <- length(unique(c(M2)[!is.na(c(M2))]))
if(dim(M)[1]==dim(M)[2]){
caption <- paste0("unique elements: total=",unitot,"; on diag=",uniond,"; off diag=",uniofd)
}else{caption <- paste0("unique elements: total=",unitot)}

# Discrete Heatmap Plot #
#########################
if(length(unique(Mm\$value)) < 10){
# as.factor
Mm\$value <- as.factor(Mm\$value)
# Force 0=white and 1=black
cols <- data.table(levels = levels(Mm\$value),
colors = distinctColorPalette(length(levels(Mm\$value))))
cols[levels==0, colors:="#FFFFFF"]; cols[levels==1, colors:="#000000"]

p <- ggplot(data = Mm, aes(x=col, y=row))
p <- p + geom_tile(aes(fill=value))
p <- p + scale_fill_manual(limits=cols\$levels, values=cols\$colors)
p <- p + guides(fill=guide_legend(title=name))

}

# Continuours Heatmap Plot #
############################
if(length(unique(Mm\$value)) >= 10){

p <- ggplot(data = Mm, aes(x=col, y=row))
p <- p + geom_tile(aes(fill=value))
p <- p + scale_fill_continuous(breaks=c(as.vector(floor(quantile(Mm\$value)[c(1,5)]))))
p <- p + guides(fill=guide_colorbar(title=name,barwidth = 0.5))

}
# ggplot in general
# y axis
if(dim(M)[1]>15){
rowbreaks <- floor(quantile(Mm\$row, names=F))
p <- p + scale_y_continuous(expand=c(0,0))
suppressMessages(p <- p + scale_y_reverse(expand=c(0,0), breaks=rowbreaks))
}else if(dim(M)[1]==1){
suppressMessages(p <- p + scale_y_continuous(expand=c(0,0)))
suppressMessages(p <- p + scale_y_reverse(expand=c(0,0), breaks=c(1)))
}else{p <- p + scale_y_reverse(expand=c(0,0))}
# x axis
if(dim(M)[2]>15){
colbreaks <- floor(quantile(Mm\$col, names=F))
p <- p + scale_x_continuous(expand=c(0,0), breaks=colbreaks)
}else if(dim(M)[2]==1){
suppressMessages(p <- p + scale_x_continuous(expand=c(0,0)))
suppressMessages(p <- p + scale_x_reverse(expand=c(0,0), breaks=c(1)))
}else{p <- p + scale_x_continuous(expand=c(0,0))}

p <- p + coord_fixed(ratio = 1)
p <- p + labs(title=caption)
p <- p + theme(panel.background = element_blank(),
panel.grid       = element_blank(),
panel.border     = element_blank(),
axis.title       = element_blank(),
plot.title = element_text(size=8))

suppressMessages(print(p))

# print aggregated info
if(dim(M)[1]==dim(M)[2]){
diaginfo <- setnames(data.table(table(diag(M))), c("V1","N"),c(" Element on diagonal","    N"))
M2       <- M
diag(M2) <- NA
offdinfo <- setnames(data.table(table(c(M2))),   c("V1","N"),c("Element off diagonal","    N"))
# Print