inst/examples/SimpleGeoms.R

In tdhock/animint2: Animated Interactive Grammar of Graphics

#' Tests for each geom
library(ggplot2Animint)
library(plyr)
library(animint2)

#' abline: should show two lines: one running through the points, the other with an intercept of 0 and slope of 2.
xydata <- data.frame(x=sort(runif(50, 0, 10)))
xydata$y <- 3+2*xydata$x + rnorm(50, 0, 1)
g1 <- ggplot() + geom_point(data=xydata, aes(x=x, y=y)) + 
  geom_abline(data=data.frame(intercept=c(3, 0), slope=c(2,1)), aes(intercept=intercept, slope=slope)) +
  ggtitle("geom_abline")
g1
# gg2animint(list(g1=g1))

#' ribbon: should show two overlapping ribbons, with the same basic shape, one translated up by one unit.
ribbondata <- data.frame(x=seq(0, 1, .1), ymin=runif(11, 0, 1), ymax=runif(11, 1, 2))
ribbondata <- rbind(cbind(ribbondata, group="low"), cbind(ribbondata, group="high"))
ribbondata[12:22,2:3] <- ribbondata[12:22,2:3]+1
g2 <- ggplot() + 
  geom_ribbon(data=ribbondata, aes(x=x, ymin=ymin, ymax=ymax, group=group, fill=group), alpha=.5) + 
  ggtitle("geom_ribbon")
g2
# gg2animint(list(g1=g1, g2=g2))

#' density: should show two normal distributions, centered at 0 and 3, and a gamma distribution with mode approximately 5
boxplotdata <- rbind(data.frame(x=1:50, y=sort(rnorm(50, 3, 1)), group="N(3,1)"),
                     data.frame(x=1:50, y=sort(rnorm(50, 0, 1)), group="N(0,1)"), 
                     data.frame(x=1:50, y=sort(rgamma(50, 2, 1/3)), group="Gamma(2,1/3)"))
boxplotdata <- ddply(boxplotdata, .(group), transform, ymax=max(y), ymin=min(y), med=median(y))

g3 <- ggplot() + geom_density(data=boxplotdata, aes(x=y, group=group, fill=group), alpha=.5) +
  scale_fill_discrete("Distribution") + xlab("x") + 
  ggtitle("geom_density")
g3
# gg2animint(list(g1=g1, g2=g2, g3=g3))


#' tile: should show an approximately bivariate normal distribution.
tiledata <- data.frame(x=rnorm(1000, 0, 3))
tiledata$y <- rnorm(1000, tiledata$x, 3)
tiledata$rx <- round(tiledata$x)
tiledata$ry <- round(tiledata$y)
tiledata <- ddply(tiledata, .(rx,ry), summarise, n=length(rx))

g4 <- ggplot() + geom_tile(data=tiledata, aes(x=rx, y=ry, fill=n)) +
  scale_fill_gradient(low="#56B1F7", high="#132B43") + 
  xlab("x") + ylab("y") + ggtitle("geom_tile")
g4
# gg2animint(list(g1=g1, g2=g2, g3=g3, g4=g4))

#' path: should show a two-dimensional random walk, where x and y are position, z is time.
pathdata <- data.frame(x=rnorm(30, 0, .5), y=rnorm(30, 0, .5), z=1:30)
g5 <- ggplot() + geom_path(data=pathdata, aes(x=x, y=y), alpha=.5) +
  geom_text(data=pathdata, aes(x=x, y=y, label=z)) + 
  ggtitle("geom_path")
g5
# gg2animint(list(g1=g1, g2=g2, g3=g3, g4=g4, g5=g5))

#' Polygons
polydata <- rbind(
  data.frame(x=c(0, .5, 1, .5, 0), y=c(0, 0, 1, 1, 0), group="parallelogram", fill="blue", xc=.5, yc=.5),
  data.frame(x=c(.5, .75, 1, .5), y=c(.5, 0, .5, .5), group="triangle", fill="red", xc=.75, yc=.33)
  )
g6 <- ggplot() + 
  geom_polygon(data=polydata, aes(x=x, y=y, group=group, fill=fill, colour=fill), alpha=.5)+
  scale_colour_identity() + scale_fill_identity()+
  geom_text(data=polydata, aes(x=xc, y=yc, label=group)) +
  ggtitle("geom_polygon")
g6
# gg2animint(list(g1=g1, g2=g2, g3=g3, g4=g4, g5=g5, g6=g6))

#' Boxplots
#' Boxplot does not work (7/5/13)
# g7 <- ggplot() + 
#   geom_boxplot(data=boxplotdata, aes(y=y, x=factor(group))) +
#   ggtitle("geom_boxplot")
# g7
# gg2animint(list(g1=g1, g2=g2, g3=g3, g4=g4, g5=g5, g6=g6, g7=g7))

g7 <- ggplot() + 
  geom_linerange(data=boxplotdata, aes(x=factor(group), ymax=ymax, ymin=ymin, colour=factor(group))) +
  ggtitle("geom_linerange") + scale_colour_discrete("Distribution") + xlab("Distribution")
g7
# gg2animint(list(g1=g1, g2=g2, g3=g3, g4=g4, g5=g5, g6=g6, g7=g7))

g8 <- ggplot() + 
  geom_histogram(data=subset(boxplotdata, group=="Gamma(2,1/3)"), aes(x=y, fill=..count..), binwidth=1) + 
  ggtitle("geom_histogram")
g8
# gg2animint(list(g1=g1, g2=g2, g3=g3, g4=g4, g5=g5, g6=g6, g7=g7, g8=g8))

g9 <- ggplot() + 
  geom_violin(data=boxplotdata, aes(x=group, y=y, fill=group, group=group)) +
  ggtitle("geom_violin")+ scale_fill_discrete("Distribution") + xlab("Distribution")
g9
# gg2animint(list(g1=g1, g2=g2, g3=g3, g4=g4, g5=g5, g6=g6, g7=g7, g8=g8, g9=g9))

#' Step Plot
#' Must specify group and then use colour=factor(group) to get desired effect.
g10 <- ggplot() + geom_step(data=boxplotdata, aes(x=x, y=y, colour=factor(group), group=group)) +
  scale_colour_discrete("Distribution") +
  ggtitle("geom_step")
g10
# gg2animint(list(g1=g1, g2=g2, g3=g3, g4=g4, g5=g5, g6=g6, g7=g7, g8=g8, g9=g9, g10=g10))

#' contour plot
library(reshape2) # for melt
contourdata <- melt(volcano)
names(contourdata) <- c("x", "y", "z")
g11 <- ggplot() + geom_contour(data=contourdata, aes(x=x, y=y, z=z), binwidth=4, size=0.5) + 
  geom_contour(data=contourdata, aes(x=x, y=y, z=z), binwidth=10, size=1) +
  ggtitle("geom_contour")
g11
# gg2animint(list(g1=g1, g2=g2, g3=g3, g4=g4, g5=g5, g6=g6, g7=g7, g8=g8, g9=g9, g10=g10, g11=g11))

contourdata2 <- floor(contourdata/3)*3
g12 <- ggplot() + 
  geom_tile(data=contourdata2, aes(x=x, y=y, fill=z, colour=z)) + 
  geom_contour(data=contourdata, aes(x=x, y=y, z=z), colour="black", size=.5) +
  scale_fill_continuous("height", low="#56B1F7", high="#132B43", guide="legend") +
  scale_colour_continuous("height", low="#56B1F7", high="#132B43", guide="legend") +
  ggtitle("geom_tile + geom_contour") 
g12
# gg2animint(list(g1=g1, g2=g2, g3=g3, g4=g4, g5=g5, g6=g6, g7=g7, g8=g8, g9=g9, g10=g10, g11=g11, g12=g12)) 

library("MASS")
data(geyser,package="MASS")
g13 <- ggplot() +  
  geom_point(data=geyser, aes(x = duration, y = waiting)) + 
  geom_contour(data=geyser, aes(x = duration, y = waiting), colour="blue", size=.5, stat="density2d") + 
  xlim(0.5, 6) + scale_y_log10(limits=c(40,110)) +
  ggtitle("geom_contour 2d density")
g13
# gg2animint(list(g1=g1, g2=g2, g3=g3, g4=g4, g5=g5, g6=g6, g7=g7, g8=g8, g9=g9, g10=g10, g11=g11, g12=g12, g13=g13))

g14 <- ggplot() +  
  geom_polygon(data=geyser,aes(x=duration, y=waiting, fill=..level.., 
                               group=..piece..), 
               stat="density2d", alpha=.5) +
  geom_point(data=geyser, aes(x = duration, y = waiting)) + 
  scale_fill_continuous("Density Level", low="#56B1F7", high="#132B43") + 
  guides(colour = guide_legend(override.aes = list(alpha = 1)), 
         fill = guide_legend(override.aes = list(alpha = 1))) + 
  scale_y_continuous(limits=c(40,110), trans="log10") +
  scale_x_continuous(limits=c(.5, 6)) +
  ggtitle("geom_density2d polygon")
g14
# gg2animint(list(g1=g1, g2=g2, g3=g3, g4=g4, g5=g5, g6=g6, g7=g7, g8=g8, g9=g9, g10=g10, g11=g11, g12=g12, g13=g13, g14=g14))


data(diamonds)
dsmall <- diamonds[sample(nrow(diamonds), 1000), ]
g15 <- ggplot() + 
  geom_tile(data=dsmall, aes(x=carat, y=price, fill=..density.., colour=..density..), stat="density2d", contour=FALSE, n=30) +
  scale_fill_gradient(limits=c(1e-5,8e-4), na.value="white") + 
  scale_colour_gradient(limits=c(1e-5,8e-4), na.value="white") +
  ggtitle("geom_density2d tile") + ylim(c(0, 19000))
g15
# gg2animint(list(g1=g1, g2=g2, g3=g3, g4=g4, g5=g5, g6=g6, g7=g7, g8=g8, g9=g9, g10=g10, g11=g11, g12=g12, g13=g13, g14=g14, g15=g15))
  
g16 <- ggplot() + 
  geom_point(data=dsmall, aes(x=carat, y=price, alpha=..density..), 
             stat="density2d", contour=FALSE, n=10, size=I(1)) +
  scale_alpha_continuous("Density") +
  ggtitle("geom_density2d points")
g16
# gg2animint(list(g1=g1, g2=g2, g3=g3, g4=g4, g5=g5, g6=g6, g7=g7, g8=g8, g9=g9, g10=g10, g11=g11, g12=g12, g13=g13, g14=g14, g15=g15, g16=g16))


#' geom_map using geom_polygon and merge
crimes <- data.frame(state = tolower(rownames(USArrests)), USArrests)
library(reshape2) # for melt
crimesm <- melt(crimes, id = 1)
library(maps)
states_map <- map_data("state")
assault.map <- merge(states_map, subset(crimesm, variable=="Assault"), by.x="region", by.y="state")
assault.map <- assault.map[order(assault.map$group, assault.map$order),]
g17 <- ggplot() + 
  geom_polygon(data=assault.map, aes(x=long, y=lat, group=group, fill=value, colour=value)) +
  expand_limits(x = states_map$long, y = states_map$lat) + 
  ggtitle("geom_polygon map") + ylim(c(12, 63)) + 
  geom_text(data=data.frame(x=-95.84, y=55, label="Arrests for Assault"), hjust=.5, aes(x=x, y=y, label=label))
g17  
# gg2animint(list(g1=g1, g2=g2, g3=g3, g4=g4, g5=g5, g6=g6, g7=g7, g8=g8, 
#                 g9=g9, g10=g10, g11=g11, g12=g12, g13=g13, g14=g14, g15=g15, 
#                 g16 = g16, g17=g17))

#' geom_bar stacked
data(mtcars)
g18 <- ggplot() + geom_bar(data=mtcars, aes(x=factor(cyl), fill=factor(vs))) + ggtitle("geom_bar stacked")
g18
# gg2animint(list(g1=g1, g2=g2, g3=g3, g4=g4, g5=g5, g6=g6, g7=g7, g8=g8, 
#                 g9=g9, g10=g10, g11=g11, g12=g12, g13=g13, g14=g14, g15=g15, 
#                 g16 = g16, g17=g17, g18=g18))

#' geom_area
data(diamonds)
g19 <- ggplot() + 
  geom_area(data=diamonds, aes(x=clarity, y=..count.., group=cut, colour=cut, fill=cut), stat="density") +
  ggtitle("geom_area")
g19
# gg2animint(list(g1=g1, g2=g2, g3=g3, g4=g4, g5=g5, g6=g6, g7=g7, g8=g8, 
#                 g9=g9, g10=g10, g11=g11, g12=g12, g13=g13, g14=g14, g15=g15, 
#                 g16 = g16, g17=g17, g18=g18, g19=g19))

g20 <- ggplot() + 
  geom_freqpoly(data=diamonds, aes(x=clarity, group=cut, colour=cut)) +
  ggtitle("geom_freqpoly")
g20
# gg2animint(list(g1=g1, g2=g2, g3=g3, g4=g4, g5=g5, g6=g6, g7=g7, g8=g8, 
#                 g9=g9, g10=g10, g11=g11, g12=g12, g13=g13, g14=g14, g15=g15, 
#                 g16 = g16, g17=g17, g18=g18, g19=g19, g20=g20))

g21 <- ggplot() + 
  geom_hex(data=dsmall, aes(x=carat, y=price)) +
  scale_fill_gradient(low="#56B1F7", high="#132B43") + 
  xlab("x") + ylab("y") + ggtitle("geom_hex")
animint2dir(list(g1=g1, g2=g2, g3=g3, g4=g4, g5=g5, g6=g6, g7=g7, g8=g8, 
                g9=g9, g10=g10, g11=g11, g12=g12, g13=g13, g14=g14, g15=g15, 
                g16 = g16, g17=g17, g18=g18, g19=g19, g20=g20, g21=g21))