CODEWITHSUNDEEP
rggplot2
user25494
user25494

Reputation: 1371

Plot thermometer graph

I ran across a blog post Favillae: Thermometer Plots in R that displayed the plot below, but did not provide the R code used.

Given these data, how can I produce the plot below?

roper_data <- structure(list(govt = c(74L, 66L, 64L, 53L, 43L, 39L, 31L), priv.co = c(64L, 
38L, 50L, 20L, 19L, 13L, 12L), police = c(27L, 34L, 25L, 22L, 
50L, 15L, 20L), ccc = c(44L, 10L, 13L, 7L, 8L, 10L, 5L)), class = "data.frame", row.names = c("Employment records", 
"Psychiatric history", "Health records", "Memberships, Associations", 
"Traffic violations", "Tax returns", "Sexual history"))

enter image description here

Upvotes: 2

Views: 1060

Answers (2)

user25494
user25494

Reputation: 1371

Alternatively, using the symbols function from base R graphics

roper <- as.matrix(roper_data)/100
z <- as.vector(roper)
x <- rep(sapply(1:4, function(x) {rep(x, 7)}),1)
y <- rep(7:1, 4)

hist_type = c("sxhist", "tax", "traffic", "assoc", "health", "psychhist", "emplhist")

par(mar=c(6, 6, 2, 2))
symbols(x, y, thermometers = cbind(0.15, 0.2, z), inches = 0.8, fg = 1, ylab='', xlab='', yaxt='n', xaxt='n')
axis(1, at = 1:4, labels = colnames(roper))
axis(2, at = 1:7, hist_type, las = 2)
mtext("Who", 1, 3, cex = 1.5)
mtext("What", 2, 4, cex = 1.5)

enter image description here

Upvotes: 1

pogibas
pogibas

Reputation: 28329

First you need to transform your data from wide to long format:

df$Var <- rownames(df)
df2 <- reshape2::melt(df, "Var")

Next we plot two sets of barplots. First layer to get the outline (max at 100) and the second one is ouractual data. We align them using facet_grid().

ggplot(df2, aes(1, value)) +
    # put 100 on as y to get the outline
    geom_bar(aes(y = 100), stat = "identity", 
             color = "black", fill = "white") +
    geom_bar(stat = "identity") +
    facet_grid(variable ~ Var) +
    labs(y = NULL,
         x = NULL) +
    theme_classic() +
    theme(axis.ticks.x = element_blank(),
          axis.text.x = element_blank())

enter image description here

You can even add more visual tweaks with the following code (add line at 50% and remove all axis) :

ggplot(df2, aes(1, value)) +
    # put line at 50%
    geom_segment(aes(x = 0.2, xend = 1.8, y = 50, yend = 50), data.frame(1)) +
    # put 100 on as y to get the outline
    geom_bar(aes(y = 100), stat = "identity", 
             color = "black", fill = "white") +
    geom_bar(stat = "identity") +
    facet_grid(variable ~ Var) +
    labs(y = NULL,
         x = NULL) +
    theme_void()

enter image description here

Upvotes: 3

Related Questions