R and rect.hclust: rectangle on labels in dendrograms - r

I am building a dendrogram for the first time and the rectangles around clusters are drawn on top of the labels. Do you know how modify the positioning of these labels in order to avoid this overlap?
Here you can find a working example of my code:
mydata <- c(9.45, 10.54, 10.36, 10.46, 10.78, 10.1, 11.13)
mydata.matrix <- matrix(mydata, nrow = 1, ncol = 7)
colnames(mydata.matrix) <- c("a", "b", "c", "d", "e", "f", "g")
rownames(mydata.matrix) <- c("X")
d <- dist(mydata.matrix["X", ], method = "euclidean")
fit <- hclust(d, method="ward.D")
nodePar <- list(lab.cex = 0.6, pch = c(NA, 19), cex = 0.7, col = "blue")
plot(as.dendrogram(fit), xlab = "", sub="", ylab = "Euclidean distance",
main = "Dendrogram", nodePar = nodePar)
rect.hclust(fit, k=2, border="red")
And here is the plot from the code above:
In particular I would like to have the red rectangles contain entirely the labels of the leaves of the dendrogram.
Thank you!

You should use the rect.dendrogram function from the dendextend package.
For example:
mydata <- c(9.45, 10.54, 10.36, 10.46, 10.78, 10.1, 11.13)
mydata.matrix <- matrix(mydata, nrow = 1, ncol = 7)
colnames(mydata.matrix) <- c("a", "b", "c", "d", "e", "f", "g")
rownames(mydata.matrix) <- c("X")
d <- dist(mydata.matrix["X", ], method = "euclidean")
fit <- hclust(d, method="ward.D")
nodePar <- list(lab.cex = 0.6, pch = c(NA, 19), cex = 0.7, col = "blue")
dend <- as.dendrogram(fit)
plot(dend, xlab = "", sub="", ylab = "Euclidean distance",
main = "Dendrogram", nodePar = nodePar)
library(dendextend)
rect.dendrogram(dend , k=2, border="red")
And you will get:
In general, for plotting dendrograms, you might find the following quick introduction to dendextend useful (or look at the more lengthy version).

Related

How can I adjust the legend box?

This is my code:
score <- tapply(exams$writing.score
, list(exams$gender,
exams$race.ethnicity
)
, mean)
plot1 <- barplot(score
, beside = TRUE
, main = "Comparison of Writing Score"
, col = c("red", "lightyellow")
, xlab = "Race Ethnicity Group"
, ylab = "Average Writing Score"
, legend.text = c("Female", "Male")
, args.legend = list(x = "topright")
)
As I want to make the box: Female and Male smaller so it does not hide the bar behind. How can I make the legend box smaller? I tried to move it to the top right of the chart, but I do not think it moves.
You could use the argument cex. Here is a reproducible example:
data <- matrix(c(1,2,3,4,5,6,7,8,9,10), ncol = 5)
colnames(data) <- paste0("V", 1:5)
rownames(data) <- c('A','B')
# Normal
barplot(data, col = 1:nrow(data))
legend("topright", legend = rownames(data), pch = 15, col = 1:nrow(data))
# With cex
barplot(data, col = 1:nrow(data))
legend("topright", legend = rownames(data), pch = 15, col = 1:nrow(data), cex = 0.5)
Created on 2022-10-21 with reprex v2.0.2
Another option (in addition to using cex as #Quinten shows) is to also change the inset to move the legend outside of the plot boundary, as well as using par to specify the parameters for margins, etc.
par(mar = c(5, 4, 4, 8),
xpd = TRUE)
# Normal
barplot(df, col = 1:nrow(df))
legend(
"topright",
inset = c(-0.1, 0),
# Create legend outside of plot
legend = rownames(df),
pch = 15,
col = 1:nrow(df),
cex = 0.8
)
Data
df <- structure(c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10), dim = c(2L, 5L), dimnames = list(
c("Female", "Male"), c("V1", "V2", "V3", "V4", "V5")))
It doesn't move because you already are at the very top. To move the top upwards and let the legend follow, expand ylim.
Also try if you like setting the legend horizontal and remove the bty (boxtype). Don't choose the cex too small.
barplot(score
, beside=TRUE
, main="Comparison of Writing Score"
, col=c("red", "lightyellow")
, xlab="Race Ethnicity Group"
, ylab="Average Writing Score"
, legend.text=c("Female", "Male")
, args.legend=list(x="topright", cex=.9, horiz=TRUE, bty='n')
, ylim=c(0, max(score)*1.2)
)
Data:
score <- structure(c(96.8, 95.2, 100, 100, 89.7, 89.2, 81.4, 81, 85.1,
82), dim = c(2L, 5L), dimnames = list(c("1", "2"), c("A", "B",
"C", "D", "E")))

R: non-numeric arguments to binary operators

I am working with the R programming language. I am trying to make a "parallel coordinates plot" using some fake data:
library(MASS)
a = rnorm(100, 10, 10)
b = rnorm(100, 10, 5)
c = rnorm(100, 5, 10)
d = matrix(a, b, c)
parcoord(d[, c(3, 1, 2)], col = 1 + (0:149) %/% 50)
However, a problem arises when I try to mix numeric and factor variables together:
group <- sample( LETTERS[1:4], 100, replace=TRUE, prob=c(0.25, 0.25, 0.25, 0.25) )
d = matrix(a,b, group)
parcoord(d[, c(3, 1, 2)], col = 1 + (0:149) %/% 50)
Error in x - min(x, na.rm = TRUE): non-numeric argument to binary operator
I am just curious. Can this problem be resolved? Or is it simply impossible to make such a plot using numeric and factor variables together?
I saw a previous stackoverflow post over here where a similar plot is made using numeric and factor variables: How to plot parallel coordinates with multiple categorical variables in R
However, I am using a computer with no USB port or internet access - I have a pre-installed version of R with limited libraries (I have plotly, ggplot2, dplyr, MASS ... I don't have ggally or tidyverse) and was looking for a way to do this only with the parcoord() function.
Does anyone have any ideas if this can be done?
Thanks
Thanks
One option is to label rows of the matrix using a factor and use that on the plot, e.g.
library(MASS)
set.seed(300)
par(xpd=TRUE)
par(mar=c(4, 4, 4, 6))
a = rnorm(12, 10, 10)
b = rnorm(12, 10, 5)
c = rnorm(12, 5, 10)
group <- sample(c("#FF9289", "#FF8AFF", "#00DB98", "#00CBFF"),
12, replace=TRUE)
d = cbind(a, b, c)
rownames(d) <- group
parcoord(d[, c(3, 1, 2)], col = group)
title(main = "Plot", xlab = "Variable", ylab = "Values")
axis(side = 2, at = seq(0, 1, 0.1),
tick = TRUE, las = 1)
legend(3.05, 1, legend = c("A", "B", "C", "D"), lty = 1,
col = c("#FF9289", "#FF8AFF", "#00DB98", "#00CBFF"))
EDIT
Thanks for the additional explanation. What you want does make sense, but unfortunately it doesn't look like it will work as I expected. I tried to make a plot using an ordered factor as the middle variable (per https://pasteboard.co/JKK4AUD.jpg) but got the same error ("non-numeric argument to binary operator").
One way I thought of doing it is to recode the factor as a number (e.g. "Var_1" -> 0.2, "Var_2" -> 0.4) as below:
library(MASS)
set.seed(123)
par(xpd=TRUE)
par(mar=c(4, 4, 4, 6))
a = rnorm(12, 10, 10)
b = c(rep("Var_1", 3),
rep("Var_2", 3),
rep("Var_3", 3),
rep("Var_4", 3))
c = rnorm(12, 5, 10)
group <- c(rep("#FF9289", 3),
rep("#FF8AFF", 3),
rep("#00DB98", 3),
rep("#00CBFF", 3))
d = data.frame("A" = a,
"Factor" = b,
"C" = c,
"Group" = group)
d$Factor <- sapply(d$Factor, switch,
"Var_1" = 0.8,
"Var_2" = 0.6,
"Var_3" = 0.4,
"Var_4" = 0.2)
parcoord(d[, c(1, 2, 3)], col = group)
title(main = "Plot", xlab = "Variable", ylab = "Values")
axis(side = 2, at = seq(0, 1, 0.1),
tick = TRUE, las = 1)
legend(3.05, 1, legend = c("A", "B", "C", "D"), lty = 1,
col = c("#FF9289", "#FF8AFF", "#00DB98", "#00CBFF"))
mtext(text = "Var 1", side = 1, adj = 0.6, padj = -30)
mtext(text = "Var 3", side = 1, adj = 0.6, padj = -12)
mtext(text = "Var 2", side = 1, adj = 0.6, padj = -21)
mtext(text = "Var 4", side = 1, adj = 0.6, padj = -3)

Position edge labels on igraph plot in R

I'm trying to use igraph to plot a causal diagram between a few variables. I below is my code and basically everything I want in the graph, except that I cannot get the other two edge labels to move up above the edges, like the one that connects "stability" to "status".
ego <- c("Stability (high)", "Stability (high)", "Stability (high)")
alter <- c("Status", "Depressive symptoms", "Anxiety Symptoms")
association <- c("-", "-", "-")
nodes <- c("Stability (high)", "Status", "Depressive symptoms", "Anxiety Symptoms")
x <- c(-5, 5, 5, 5)
y <- c(4, 8, 4, 0)
edges <- as.data.frame(cbind(ego, alter, association))
nodes <- cbind.data.frame(nodes, x, y)
nodes$x <- as.numeric(nodes$x)
nodes$y <- as.numeric(nodes$y)
study1 <- graph_from_data_frame(edges, nodes, directed = TRUE)
E(study1)$color <- "red"
plot(study1, layout=as.matrix(nodes[,c("x","y")]),
vertex.size = 75,
vertex.color = "gray",
vertex.label.color = "black",
vertex.label.family = "Arial",
vertex.label.cex = 0.7,
edge.arrow.size = 0.7,
edge.width = 3.5,
edge.color = E(study1)$color,
edge.label = E(study1)$association,
edge.label.y = 0.5,
edge.label.cex = 3,
edge.label.color = "black")
You have to specify for each label the y-coordinate, i.e. edge.label.y = c(0.6, 0.2, -0.5) . I changed your code a little bit so you can see which label is which, i.e. association <- c("A", "B", "C")
The complete code:
library(igraph)
ego <- c("Stability (high)", "Stability (high)", "Stability (high)")
alter <- c("Status", "Depressive symptoms", "Anxiety Symptoms")
association <- c("A", "B", "C")
nodes <- c("Stability (high)", "Status", "Depressive symptoms", "Anxiety Symptoms")
x <- c(-5, 5, 5, 5)
y <- c(4, 8, 4, 0)
edges <- as.data.frame(cbind(ego, alter, association))
nodes <- cbind.data.frame(nodes, x, y)
nodes$x <- as.numeric(nodes$x)
nodes$y <- as.numeric(nodes$y)
study1 <- graph_from_data_frame(edges, nodes, directed = TRUE)
E(study1)$color <- "red"
plot(study1, layout=as.matrix(nodes[,c("x","y")]),
vertex.size = 75,
vertex.color = "gray",
vertex.label.color = "black",
vertex.label.family = "Arial",
vertex.label.cex = 0.7,
edge.arrow.size = 0.7,
edge.width = 3.5,
edge.color = E(study1)$color,
edge.label = E(study1)$association,
edge.label.y = c(0.6, 0.2, -0.5), # specify the y-coordinate for each label
edge.label.cex = 3,
edge.label.color = "black")
This wil result in:

Plot observation number (label) in outlier points

I have this boxplot with outliers, i need to plot the number of the line that contain the outlier observation, to make it easy to go in the data set and find where the value, somebody can help me?
set.seed(1)
a <- runif(10,1,100)
b <-c("A","A","A","A","A","B","B","B","B","B")
t <- cbind(a,b)
bp <- boxplot(a~b)
text(x = 1, y = bp$stats[,1] + 2, labels = round(bp$stats[,1], 2))
text(x = 2, y = bp$stats[,2] + 2, labels = round(bp$stats[,2], 2))
What is the point of t <- cbind(a, b)? That makes a character matrix and converts your numbers to character strings? You don't use it anyway. If you want a single data structure use data.frame(a, b) which will make a a factor and leave b numeric. I do not get the plot you do with set.seed(1) so I'll provide slightly different data. Note the use of the pos= and offset= arguments in text(). Be sure to read the manual page to see what they are doing:
a <- c(99.19, 59.48, 48.95, 18.17, 75.73, 45.94, 51.61, 21.55, 37.41,
59.98, 57.91, 35.54, 4.52, 64.64, 75.03, 60.21, 56.53, 53.08,
98.52, 51.26)
b <- c("A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "B", "B",
"B", "B", "B", "B", "B", "B", "B", "B")
bp <- boxplot(a~b)
text(x = 1, y = bp$stats[,1], labels = round(bp$stats[, 1], 2),
pos=c(1, 3, 3, 1, 3), offset=.2)
text(x = 2, y = bp$stats[, 2], labels = round(bp$stats[, 2], 2),
pos=c(1, 3, 3, 1, 3), offset=.2)
obs <- which(a %in% bp$out)
text(bp$group, bp$out, obs, pos=4)

R how to visualize confusion matrix using the caret package

I'd like to visualize the data I've put in the confusion matrix. Is there a function I could simply put the confusion matrix and it would visualize it (plot it)?
Example what I'd like to do(Matrix$nnet is simply a table containing results from the classification):
Confusion$nnet <- confusionMatrix(Matrix$nnet)
plot(Confusion$nnet)
My Confusion$nnet$table looks like this:
prediction (I would also like to get rid of this string, any help?)
1 2
1 42 6
2 8 28
You can just use the rect functionality in r to layout the confusion matrix. Here we will create a function that allows the user to pass in the cm object created by the caret package in order to produce the visual.
Let's start by creating an evaluation dataset as done in the caret demo:
# construct the evaluation dataset
set.seed(144)
true_class <- factor(sample(paste0("Class", 1:2), size = 1000, prob = c(.2, .8), replace = TRUE))
true_class <- sort(true_class)
class1_probs <- rbeta(sum(true_class == "Class1"), 4, 1)
class2_probs <- rbeta(sum(true_class == "Class2"), 1, 2.5)
test_set <- data.frame(obs = true_class,Class1 = c(class1_probs, class2_probs))
test_set$Class2 <- 1 - test_set$Class1
test_set$pred <- factor(ifelse(test_set$Class1 >= .5, "Class1", "Class2"))
Now let's use caret to calculate the confusion matrix:
# calculate the confusion matrix
cm <- confusionMatrix(data = test_set$pred, reference = test_set$obs)
Now we create a function that lays out the rectangles as needed to showcase the confusion matrix in a more visually appealing fashion:
draw_confusion_matrix <- function(cm) {
layout(matrix(c(1,1,2)))
par(mar=c(2,2,2,2))
plot(c(100, 345), c(300, 450), type = "n", xlab="", ylab="", xaxt='n', yaxt='n')
title('CONFUSION MATRIX', cex.main=2)
# create the matrix
rect(150, 430, 240, 370, col='#3F97D0')
text(195, 435, 'Class1', cex=1.2)
rect(250, 430, 340, 370, col='#F7AD50')
text(295, 435, 'Class2', cex=1.2)
text(125, 370, 'Predicted', cex=1.3, srt=90, font=2)
text(245, 450, 'Actual', cex=1.3, font=2)
rect(150, 305, 240, 365, col='#F7AD50')
rect(250, 305, 340, 365, col='#3F97D0')
text(140, 400, 'Class1', cex=1.2, srt=90)
text(140, 335, 'Class2', cex=1.2, srt=90)
# add in the cm results
res <- as.numeric(cm$table)
text(195, 400, res[1], cex=1.6, font=2, col='white')
text(195, 335, res[2], cex=1.6, font=2, col='white')
text(295, 400, res[3], cex=1.6, font=2, col='white')
text(295, 335, res[4], cex=1.6, font=2, col='white')
# add in the specifics
plot(c(100, 0), c(100, 0), type = "n", xlab="", ylab="", main = "DETAILS", xaxt='n', yaxt='n')
text(10, 85, names(cm$byClass[1]), cex=1.2, font=2)
text(10, 70, round(as.numeric(cm$byClass[1]), 3), cex=1.2)
text(30, 85, names(cm$byClass[2]), cex=1.2, font=2)
text(30, 70, round(as.numeric(cm$byClass[2]), 3), cex=1.2)
text(50, 85, names(cm$byClass[5]), cex=1.2, font=2)
text(50, 70, round(as.numeric(cm$byClass[5]), 3), cex=1.2)
text(70, 85, names(cm$byClass[6]), cex=1.2, font=2)
text(70, 70, round(as.numeric(cm$byClass[6]), 3), cex=1.2)
text(90, 85, names(cm$byClass[7]), cex=1.2, font=2)
text(90, 70, round(as.numeric(cm$byClass[7]), 3), cex=1.2)
# add in the accuracy information
text(30, 35, names(cm$overall[1]), cex=1.5, font=2)
text(30, 20, round(as.numeric(cm$overall[1]), 3), cex=1.4)
text(70, 35, names(cm$overall[2]), cex=1.5, font=2)
text(70, 20, round(as.numeric(cm$overall[2]), 3), cex=1.4)
}
Finally, pass in the cm object that we calculated when using caret to create the confusion matrix:
draw_confusion_matrix(cm)
And here are the results:
You could use the built-in fourfoldplot. For example,
ctable <- as.table(matrix(c(42, 6, 8, 28), nrow = 2, byrow = TRUE))
fourfoldplot(ctable, color = c("#CC6666", "#99CC99"),
conf.level = 0, margin = 1, main = "Confusion Matrix")
You could use the function conf_mat() from yardstick plus autoplot() to get in a few rows a pretty nice result.
Plus you can still use basic ggplot sintax in order to fix the styling.
library(yardstick)
library(ggplot2)
# The confusion matrix from a single assessment set (i.e. fold)
cm <- conf_mat(truth_predicted, obs, pred)
autoplot(cm, type = "heatmap") +
scale_fill_gradient(low="#D6EAF8",high = "#2E86C1")
Just as an example of further customizations, using ggplot sintax you can also add back the legend with:
+ theme(legend.position = "right")
Changing the name of the legend would be pretty easy too : + labs(fill="legend_name")
Data Example:
set.seed(123)
truth_predicted <- data.frame(
obs = sample(0:1,100, replace = T),
pred = sample(0:1,100, replace = T)
)
truth_predicted$obs <- as.factor(truth_predicted$obs)
truth_predicted$pred <- as.factor(truth_predicted$pred)
I really liked the beautiful confusion matrix visualization from #Cybernetic and made two tweaks to hopefully improve it further.
1) I swapped out the Class1 and Class2 with the actual values of the classes.
2) I replace the orange and blue colors with a function that generates red (misses) and green (hits) based on percentiles. The idea is to quickly see where the problems/successes are and their sizes.
Screenshot and code:
draw_confusion_matrix <- function(cm) {
total <- sum(cm$table)
res <- as.numeric(cm$table)
# Generate color gradients. Palettes come from RColorBrewer.
greenPalette <- c("#F7FCF5","#E5F5E0","#C7E9C0","#A1D99B","#74C476","#41AB5D","#238B45","#006D2C","#00441B")
redPalette <- c("#FFF5F0","#FEE0D2","#FCBBA1","#FC9272","#FB6A4A","#EF3B2C","#CB181D","#A50F15","#67000D")
getColor <- function (greenOrRed = "green", amount = 0) {
if (amount == 0)
return("#FFFFFF")
palette <- greenPalette
if (greenOrRed == "red")
palette <- redPalette
colorRampPalette(palette)(100)[10 + ceiling(90 * amount / total)]
}
# set the basic layout
layout(matrix(c(1,1,2)))
par(mar=c(2,2,2,2))
plot(c(100, 345), c(300, 450), type = "n", xlab="", ylab="", xaxt='n', yaxt='n')
title('CONFUSION MATRIX', cex.main=2)
# create the matrix
classes = colnames(cm$table)
rect(150, 430, 240, 370, col=getColor("green", res[1]))
text(195, 435, classes[1], cex=1.2)
rect(250, 430, 340, 370, col=getColor("red", res[3]))
text(295, 435, classes[2], cex=1.2)
text(125, 370, 'Predicted', cex=1.3, srt=90, font=2)
text(245, 450, 'Actual', cex=1.3, font=2)
rect(150, 305, 240, 365, col=getColor("red", res[2]))
rect(250, 305, 340, 365, col=getColor("green", res[4]))
text(140, 400, classes[1], cex=1.2, srt=90)
text(140, 335, classes[2], cex=1.2, srt=90)
# add in the cm results
text(195, 400, res[1], cex=1.6, font=2, col='white')
text(195, 335, res[2], cex=1.6, font=2, col='white')
text(295, 400, res[3], cex=1.6, font=2, col='white')
text(295, 335, res[4], cex=1.6, font=2, col='white')
# add in the specifics
plot(c(100, 0), c(100, 0), type = "n", xlab="", ylab="", main = "DETAILS", xaxt='n', yaxt='n')
text(10, 85, names(cm$byClass[1]), cex=1.2, font=2)
text(10, 70, round(as.numeric(cm$byClass[1]), 3), cex=1.2)
text(30, 85, names(cm$byClass[2]), cex=1.2, font=2)
text(30, 70, round(as.numeric(cm$byClass[2]), 3), cex=1.2)
text(50, 85, names(cm$byClass[5]), cex=1.2, font=2)
text(50, 70, round(as.numeric(cm$byClass[5]), 3), cex=1.2)
text(70, 85, names(cm$byClass[6]), cex=1.2, font=2)
text(70, 70, round(as.numeric(cm$byClass[6]), 3), cex=1.2)
text(90, 85, names(cm$byClass[7]), cex=1.2, font=2)
text(90, 70, round(as.numeric(cm$byClass[7]), 3), cex=1.2)
# add in the accuracy information
text(30, 35, names(cm$overall[1]), cex=1.5, font=2)
text(30, 20, round(as.numeric(cm$overall[1]), 3), cex=1.4)
text(70, 35, names(cm$overall[2]), cex=1.5, font=2)
text(70, 20, round(as.numeric(cm$overall[2]), 3), cex=1.4)
}
Here a simple ggplot2 based idea that can be changed as desired, I'm using the data from this link:
#data
confusionMatrix(iris$Species, sample(iris$Species))
newPrior <- c(.05, .8, .15)
names(newPrior) <- levels(iris$Species)
cm <-confusionMatrix(iris$Species, sample(iris$Species))
Now cm is a confusion matrix object, it's possible to take out something useful for the purpose of the question:
# extract the confusion matrix values as data.frame
cm_d <- as.data.frame(cm$table)
# confusion matrix statistics as data.frame
cm_st <-data.frame(cm$overall)
# round the values
cm_st$cm.overall <- round(cm_st$cm.overall,2)
# here we also have the rounded percentage values
cm_p <- as.data.frame(prop.table(cm$table))
cm_d$Perc <- round(cm_p$Freq*100,2)
Now we're ready to plot:
library(ggplot2) # to plot
library(gridExtra) # to put more
library(grid) # plot together
# plotting the matrix
cm_d_p <- ggplot(data = cm_d, aes(x = Prediction , y = Reference, fill = Freq))+
geom_tile() +
geom_text(aes(label = paste("",Freq,",",Perc,"%")), color = 'red', size = 8) +
theme_light() +
guides(fill=FALSE)
# plotting the stats
cm_st_p <- tableGrob(cm_st)
# all together
grid.arrange(cm_d_p, cm_st_p,nrow = 1, ncol = 2,
top=textGrob("Confusion Matrix and Statistics",gp=gpar(fontsize=25,font=1)))
I know this is quite late, but I was looking for a solution my self.
Working on some of the previous answers above, in addition to this post.
Using ggplot2 package and base table function, I made this simple function to plot a nicely colored confusion matrix:
conf_matrix <- function(df.true, df.pred, title = "", true.lab ="True Class", pred.lab ="Predicted Class",
high.col = 'red', low.col = 'white') {
#convert input vector to factors, and ensure they have the same levels
df.true <- as.factor(df.true)
df.pred <- factor(df.pred, levels = levels(df.true))
#generate confusion matrix, and confusion matrix as a pecentage of each true class (to be used for color)
df.cm <- table(True = df.true, Pred = df.pred)
df.cm.col <- df.cm / rowSums(df.cm)
#convert confusion matrices to tables, and binding them together
df.table <- reshape2::melt(df.cm)
df.table.col <- reshape2::melt(df.cm.col)
df.table <- left_join(df.table, df.table.col, by =c("True", "Pred"))
#calculate accuracy and class accuracy
acc.vector <- c(diag(df.cm)) / c(rowSums(df.cm))
class.acc <- data.frame(Pred = "Class Acc.", True = names(acc.vector), value = acc.vector)
acc <- sum(diag(df.cm)) / sum(df.cm)
#plot
ggplot() +
geom_tile(aes(x=Pred, y=True, fill=value.y),
data=df.table, size=0.2, color=grey(0.5)) +
geom_tile(aes(x=Pred, y=True),
data=df.table[df.table$True==df.table$Pred, ], size=1, color="black", fill = 'transparent') +
scale_x_discrete(position = "top", limits = c(levels(df.table$Pred), "Class Acc.")) +
scale_y_discrete(limits = rev(unique(levels(df.table$Pred)))) +
labs(x=pred.lab, y=true.lab, fill=NULL,
title= paste0(title, "\nAccuracy ", round(100*acc, 1), "%")) +
geom_text(aes(x=Pred, y=True, label=value.x),
data=df.table, size=4, colour="black") +
geom_text(data = class.acc, aes(Pred, True, label = paste0(round(100*value), "%"))) +
scale_fill_gradient(low=low.col, high=high.col, labels = scales::percent,
limits = c(0,1), breaks = c(0,0.5,1)) +
guides(size=F) +
theme_bw() +
theme(panel.border = element_blank(), legend.position = "bottom",
axis.text = element_text(color='black'), axis.ticks = element_blank(),
panel.grid = element_blank(), axis.text.x.top = element_text(angle = 30, vjust = 0, hjust = 0)) +
coord_fixed()
}
You can just copy and paste the function, and save it to your global environment.
Here's an example:
mydata <- data.frame(true = c("a", "b", "c", "a", "b", "c", "a", "b", "c"),
predicted = c("a", "a", "c", "c", "a", "c", "a", "b", "c"))
conf_matrix(mydata$true, mydata$predicted, title = "Conf. Matrix Example")
cvms has plot_confusion_matrix() as well with some bells and whistles:
# Create targets and predictions data frame
data <- data.frame(
"target" = c("A", "B", "A", "B", "A", "B", "A", "B",
"A", "B", "A", "B", "A", "B", "A", "A"),
"prediction" = c("B", "B", "A", "A", "A", "B", "B", "B",
"B", "B", "A", "B", "A", "A", "A", "A"),
stringsAsFactors = FALSE
)
# Evaluate predictions and create confusion matrix
eval <- evaluate(
data = data,
target_col = "target",
prediction_cols = "prediction",
type = "binomial"
)
eval
> # A tibble: 1 x 19
> `Balanced Accuracy` Accuracy F1 Sensitivity Specificity `Pos Pred Value` `Neg Pred Value` AUC `Lower CI`
> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
> 1 0.690 0.688 0.667 0.714 0.667 0.625 0.75 0.690 0.447
> # … with 10 more variables: Upper CI <dbl>, Kappa <dbl>, MCC <dbl>, Detection Rate <dbl>,
> # Detection Prevalence <dbl>, Prevalence <dbl>, Predictions <list>, ROC <named list>, Confusion Matrix <list>,
> # Process <list>
# Plot confusion matrix
# Either supply confusion matrix tibble directly
plot_confusion_matrix(eval[["Confusion Matrix"]][[1]])
# Or plot first confusion matrix in evaluate() output
plot_confusion_matrix(eval)
The output is a ggplot object.
Simplest way, incorporating caret:
library(caret)
library(yardstick)
library(ggplot2)
Train model
plsFit <- train(
y ~ .,
data = trainData
)
Get predictions from model
plsClasses <- predict(plsFit, newdata = testdata)
truth_predicted<-data.frame(
obs = testdata$y,
pred = plsClasses
)
Make matrix. Notice obs and pred aren't strings
cm <- conf_mat(truth_predicted, obs, pred)
Plot
autoplot(cm, type = "heatmap") +
scale_fill_gradient(low="#D6EAF8",high = "#2E86C1")

Resources