8

How can I do a graph similar to this (the dollar image graph)? Or what packages can I do this with? I have a (gg)plot using geom_area.

Dollar graph image

Dollar graph image

smci
  • 32,567
  • 20
  • 113
  • 146

1 Answers1

15

This is purely for novelty purposes, right?

In the code below, we cover up the portion of the dollar bill above the blue curve using geom_ribbon.

library(jpeg)
library(grid)
library(ggplot2)
library(scales)
theme_set(theme_classic())

# Load image of dollar bill and convert to raster grob
download.file("https://2marks.files.wordpress.com/2013/07/george-washington-on-one-dollar-bill.jpg", 
              "dollar_bill.jpg")
db = readJPEG("dollar_bill.jpg")
db = rasterGrob(db, interpolate=TRUE) 

# Fake data
set.seed(3)
dat = data.frame(x=1913:2009)
dat$y2 = seq(5,950, length=nrow(dat)) + rnorm(nrow(dat), 0, 5)
dat$y1 = seq(100,5,length=nrow(dat)) + c(0, -0.5, rnorm(nrow(dat) - 2, 0, 2))

ggplot(dat, aes(x, y1)) +
  annotation_custom(db, xmin=1913, xmax=2009, ymin=0, ymax=100) +
  geom_ribbon(aes(ymin=y1, ymax=100), fill="white") +
  geom_line(size=1, colour="blue") +
  geom_line(aes(y=y2/10), size=1, colour="red") +
  coord_fixed(ratio=1/2.5) +
  scale_y_continuous(limits=c(0,100), expand=c(0,0),
                     sec.axis=sec_axis(~.*10, name="Currency in Circulation\n(billions)", labels=dollar)) +
  scale_x_continuous(limits=c(1913,2009), expand=c(0,0)) +
  labs(x="", y="Purchasing Power\n(1913=100)") +
  theme(axis.text.y.right=element_text(colour="red"),
        axis.title.y.right=element_text(colour="red"),
        axis.text.y=element_text(colour="blue"),
        axis.title.y=element_text(colour="blue"),
        axis.title.x=element_blank())

enter image description here

eipi10
  • 91,525
  • 24
  • 209
  • 285
  • 1
    As horrific as such things seem to purists, chartjunk has demonstrable benefits: http://hci.usask.ca/publications/view.php?id=173 – Brian Aug 20 '17 at 03:06
  • Link has gone dead, but it's on Web Archive if anyone is interested: http://web.archive.org/web/20181210010707/http://hci.usask.ca/uploads/173-pap0297-bateman.pdf – thelatemail Jul 07 '22 at 00:43