RG#106: add satellite imagery, or open street maps to your plots using openmap package (bing, mapquest)

library(OpenStreetMap)
library(rgdal)




# get world map
map <- openmap(c(70,-179), c(-70,179))

plot(map)




bingmap <- openmap(c(70,-179), c(-70,179), type = "bing")

plot(bingmap)







# types available 

# type = c("osm", "osm-bw", "maptoolkit-topo", "waze", "mapquest", "mapquest-aerial", "bing", "stamen-toner", "stamen-terrain", "stamen-watercolor", "osm-german", "osm-wanderreitkarte", "mapbox", "esri", "esri-topo", "nps", "apple-iphoto", "skobbler", "cloudmade-<id>", "hillshade", "opencyclemap", "osm-transport", "osm-public-transport", "osm-bbike", "osm-bbike-german")

#zoom maps, plot a portion

# upperLeft, lowerRight

lat <- c(43.834526782236814, 30.334953881988564)

lon <- c(-85.8857421875, -70.0888671875)

southest <- openmap(c(lat[1],lon[1]),c(lat[2],lon[2]),zoom=7,'osm')

plot(southest) 










library(UScensus2000tract)

data(south_carolina.tract)

lat <- c(35.834526782236814, 30.334953881988564)

lon <- c(-85.8857421875, -70.0888671875)

southest <- openmap(c(lat[1],lon[1]),c(lat[2],lon[2]),zoom=7,'osm')

south_carolina.tract <- spTransform(south_carolina.tract,osm())

plot(southest)
plot(south_carolina.tract,add=TRUE,col=(south_carolina.tract@data$med.age>35)+4)







plot(southest)
plot(south_carolina.tract,add=TRUE,col=(south_carolina.tract@data$med.age>55)+4)












RG#100: Trellis map plot with heatmap colors

require(maps)
library(mapproj)

worldmap <- map('world', plot = FALSE, fill = FALSE,  projection = "azequalarea")
country = worldmap$names
set.seed(1234)
var.2010 = rnorm (length (country), 20, 10)
var.2011 = var.2010*1.1 + rnorm (length (country), 0, 1)
var.2012 = var.2011*0.98 + rnorm (length (country), 0, 4)
var.2013 = var.2011*0.98 + rnorm (length (country), 0, 30)
worldt <- data.frame (country, var.2010, var.2011, var.2012, var.2013)

mapplot(country ~ var.2011, worldt, map = map("world",     plot = FALSE, fill = TRUE))

mapplot(country ~ var.2010 + var.2011 + var.2012 + var.2013, data = worldt, map = map("world",     plot = FALSE, fill = TRUE))

# trellis plot for country maps not available in maps package:

 require(maptools)
# get the map; may need sometime to be loaded 
con <- url("http://gadm.org/data/rda/NPL_adm3.RData")
print(load(con))
close(con)

# from your data file working directory 
## load ("NPL_adm3.RData")

# data 
districts = gadm$NAME_3
set.seed(1234)
var1 <- rnorm (length (districts), 100, 30)
var2 <- rnorm (length (districts), 100, 30)
 myd <- data.frame (districts, var1, var2)    

# US county level map 

uscountymap <- map('county', plot = FALSE, fill = FALSE,  projection = "azequalarea")
county = uscountymap$names
set.seed(1234)
var.2010 = rnorm (length (county), 50, 10)
var.2011 = var.2010*1.1 + rnorm (length (county), 0, 5)
var.2012 = var.2011*0.98 + rnorm (length (county), 0, 10)
var.2013 = var.2011*1.2 + rnorm (length (county), 0, 15)
uscounty <- data.frame (county, var.2010, var.2011, var.2012, var.2013)

mapplot(county ~ var.2010 + var.2011 + var.2012 + var.2013, data = uscounty, map = map("county",    plot = FALSE, fill = TRUE))

# US state level map 
usstmap <- map('state', plot = FALSE, fill = FALSE,  projection = "azequalarea")
state = usstmap$names
set.seed(1234)
var.2010 = rnorm (length (state), 50, 10)
var.2011 = var.2010*1.1 + rnorm (length (state), 0, 5)
var.2012 = var.2011*0.98 + rnorm (length (state), 0, 10)
var.2013 = var.2011*1.2 + rnorm (length (state), 0, 15)
usst <- data.frame (county, var.2010, var.2011, var.2012, var.2013)

mapplot(state ~ var.2010 + var.2011 + var.2012 + var.2013, data = usst, map = map("state",    plot = FALSE, fill = TRUE), colramp = colorRampPalette(c("green", "purple")))

RG#99: cloud 3D bars with heatmap

require(lattice)

require(latticeExtra)

data(VADeaths)

cloud(VADeaths, panel.3d.cloud = panel.3dbars,
      xbase = 0.4, ybase = 0.4, zlim = c(0, max(VADeaths)),
      scales = list(arrows = FALSE, just = "right"), xlab = NULL, ylab = NULL,
      col.facet = level.colors(VADeaths, at = do.breaks(range(VADeaths), 20),
                               col.regions = cm.colors,
                               colors = TRUE),
      colorkey = list(col = cm.colors, at = do.breaks(range(VADeaths), 20)),
      screen = list(z = 40, x = -30))

RG#79: Heatmap with overlayed circle (size and color)

set.seed (78888)
rectheat = sample(c(rnorm (10, 5,1), NA, NA), 150, replace = T)
circlefill =  rectheat*10 + rnorm (length (rectheat), 0, 3)
circlesize = rectheat*1.5 + rnorm (length (rectheat), 0, 3)
myd <- data.frame (rowv = rep (1:10, 15), columnv = rep(1:15, each = 10),
          rectheat, circlesize, circlefill)
          
          
require(ggplot2)
 pl1 <-  ggplot(myd, aes(y = factor(rowv),  x = factor(columnv))) +  geom_tile(aes(fill = rectheat)) +  scale_fill_continuous(low = "blue", high = "green")


  pl1  +      geom_point(aes(colour = circlefill,  size =circlesize))  +    scale_color_gradient(low = "yellow",   high = "red")+     scale_size(range = c(1, 20))+   theme_bw()

RG#72: XY plot with heatmap strip at margin

set.seed(1234)
mydata <- data.frame (Xv = rnorm (300, 50, 10), Yv = rnorm (300, 10, 3))
mydata$xcat <- cut (mydata$Xv, 10)
mydata$ycat <- cut (mydata$Yv, 10)



# plot 

require(ggplot2)
require(grid)

#Scatter plot without axis titles
p<-ggplot(mydata, aes(x=Xv, y=Yv)) +    geom_point(shape=19)  +
  theme_bw() 

#tile plot for the x axis
px<-ggplot(mydata,aes(x=xcat,y=1,fill=xcat))+geom_tile()+
  scale_x_discrete(expand=c(0,0))+
  scale_fill_hue(h=c(0,120))+
  scale_y_continuous(expand=c(0,0),breaks=1,labels="10")+
  theme(legend.position="none",
        axis.title=element_blank(),
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank(),
        axis.text.y=element_text(color="white"),
        axis.ticks.y=element_line(color="white"))

#tile plot for the y axis
py<-ggplot(mydata,aes(x=1,y=ycat,fill=ycat))+geom_tile()+
  scale_y_discrete(expand=c(0,0))+
  scale_x_continuous(expand=c(0,0),breaks=1,labels="1")+
  scale_fill_hue(h=c(181,360))+
  theme(legend.position="none",
        axis.title=element_blank(),
        axis.text.y=element_blank(),
        axis.ticks.y=element_blank(),
        axis.text.x=element_text(color="white"),
        axis.ticks.x=element_line(color="white"))

#Define layout for the plots (2 rows, 2 columns)
layt<-grid.layout(nrow=2,ncol=2,heights=c(7/8,1/8),widths=c(1/8,7/8),default.units=c('null','null'))
#View the layout of plots
grid.show.layout(layt)

#Draw plots one by one in their positions
grid.newpage()
pushViewport(viewport(layout=layt))
print(py,vp=viewport(layout.pos.row=1,layout.pos.col=1))
print(p,vp=viewport(layout.pos.row=1,layout.pos.col=2))
print(px,vp=viewport(layout.pos.row=2,layout.pos.col=2))

RG#73: triple (three) heatmap plot - one center (XY) and other two at X and Y axis direction

 library(ggplot2);
 library(reshape2)
 library (grid)

#X axis quantitaive ggplot data
datfx <- data.frame(indv=factor(paste("ID", 1:20, sep = ""),
     levels =rev(paste("ID", 1:20, sep = ""))), matrix(sample(LETTERS[1:7],80, T), ncol = 4))
 # converting data to long form for ggplot2 use
  datf1x <- melt(datfx, id.var = 'indv')
plotx <-  ggplot(datf1x, aes(indv, variable)) + geom_tile(aes(fill = value),
 colour = "white")  +   scale_fill_manual(values= terrain.colors(7))+ scale_x_discrete(expand=c(0,0))
px <- plotx

#Y axis quantitaive ggplot data
datfy <- data.frame(indv=factor(paste("ID", 21:40, sep = ""),
     levels =rev(paste("ID",21:40, sep = ""))), matrix(sample(LETTERS[7:10],100, T), ncol = 5))
 # converting data to long form for ggplot2 use
  datf1y <- melt(datfy, id.var = 'indv')
ploty <-  ggplot(datf1y, aes( variable, indv)) + geom_tile(aes(fill = value),
 colour = "white")  +   scale_fill_manual(values= c("cyan4", "midnightblue", "green2", "lightgreen")) + scale_x_discrete(expand=c(0,0))
py <- ploty  +  theme(legend.position="left",  axis.title=element_blank())
 )

# plot XY quantative fill
datfxy <- data.frame(indv=factor(paste("ID", 1:20, sep = ""),
     levels =rev(paste("ID", 1:20, sep = ""))), matrix(rnorm (400, 50, 10), ncol = 20))
names (datfxy) <- c("indv",paste("ID", 21:40, sep = ""))
 datfxy <- melt(datfxy, id.var = 'indv')
  levels (datfxy$ variable) <- rev(paste("ID", 21:40, sep = ""))
pxy <- plotxy <-  ggplot(datfxy, aes(indv, variable)) + geom_tile(aes(fill = value),
 colour = "white")  + scale_fill_gradient(low="red", high="yellow") + theme(
        axis.title=element_blank())



#Define layout for the plots (2 rows, 2 columns)
layt<-grid.layout(nrow=2,ncol=2,heights=c(6/8,2/8),widths=c(2/8,6/8),default.units=c('null','null'))
#View the layout of plots
grid.show.layout(layt)

#Draw plots one by one in their positions
grid.newpage()
pushViewport(viewport(layout=layt))
print(py,vp=viewport(layout.pos.row=1,layout.pos.col=1))
print(pxy,vp=viewport(layout.pos.row=1,layout.pos.col=2))
print(px,vp=viewport(layout.pos.row=2,layout.pos.col=2))

RG#71: Barplot (histogram) with heatmap strip at margin

require(grid)
require(ggplot2)

plt1<-ggplot(myd, aes(x=nam, y=Yv, fill = nam)) +   geom_bar(stat = "identity")  +
 theme(axis.title=element_blank()) + scale_fill_manual(values= c("green1", "green3", "green4", "blue1",
  "blue3", "purple", "tan", "gray50")) +  theme_bw()



 #tile plot for the x axis
px<-ggplot(myd,aes(x=nam,y=1,fill=Zv))+geom_bar(stat = "identity", width=1, col = "yellow") +
 scale_fill_gradient(low = "green4", high = "red") + scale_x_discrete(expand=c(0,0)) +  theme(
        axis.title=element_blank(),
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank(),
        axis.text.y=element_text(color="white"),
        axis.ticks.y=element_line(color="white"))

#Define layout (2 rows, 1 columns)
lyt<-grid.layout(nrow=2,ncol=1,heights=c(7/8,1/8),widths=c(8),default.units=c('null','null'))

#View the layout of plots
#grid.show.layout(lyt)

#plots
grid.newpage()
pushViewport(viewport(layout=lyt))
print(plt1,vp=viewport(layout.pos.row=1,layout.pos.col=1))
print(px,vp=viewport(layout.pos.row=2,layout.pos.col=1))

RG#67: Histogram with heatmap color in bars

# data 
set.seed(1234)
XV <- data.frame (x = rnorm(2000, 15, 4))

#plot 

plot1 <- ggplot(data = XV, aes(x = x, y = ..density..)) +
  geom_histogram(aes(fill = ..density..), binwidth = 0.25) +
  stat_density(geom = "path", size = 1, alpha = 0.5) +
  scale_y_continuous(expand = c(0.01, 0)) + scale_fill_gradient(low = "green4", high = "red") + xlab("Time") + ylab("Density") + theme_bw(16, "serif") +
  theme(legend.position = "none")

print(plot1)

RG#63: Spartial grid plot

require(sp)

data(meuse.grid)

# gridd the data
gridded(meuse.grid)=~x+y

meuse.grid$g = factor(sample(letters[1:5], 3103, replace=TRUE),levels=letters[1:10])


meuse.grid$f = factor(sample(letters[6:10], 3103, replace=TRUE),levels=letters[1:10])

spplot(meuse.grid, c("f","g"))

spplot(meuse.grid, c("f","g"), col.regions=bpy.colors(10))

 

RG#59: US state map with county data filled

require(maps)

map('state', region = c('michigan', 'ohio', 'indiana', 'illinois'), 

fill = TRUE, 


col = c("red", "green4",  "pink", "pink", "yellow"))

# rem: michigan has two polygons

 

 

# fill at county level for michigan  

map('county', region = c('michigan'),

fill = TRUE, col = rainbow (9))

 

 

 

RG#60: Plot world map and fill colors (heatmap)

 require(maps)

# just random colors

worldmap <- map('world', fill = TRUE, col = rainbow (7))

 

# generating random variable to fill colors

set.seed(123)

filld <- data.frame (country.reg = worldmap$names, yvar = rnorm (length(worldmap$names), 50, 30))

# now device colors from yvar data category

 # brewing color for continious color filling
library(RColorBrewer)
plotclr <- brewer.pal(6,"YlOrRd")#

# categorize in different class for yvar
 filld$colorBuckets <- as.numeric(cut(filld$yvar, c(0, 30, 50, 70, 90, 130)))
# corresponding legend text
legdtxt <- c("<0%", "0-30%", "30-50%", "50-70%", "70-90%", ">90%")

map('world', fill = TRUE, col = plotclr )
legend("bottomleft", legdtxt, horiz = FALSE, fill = plotclr)

 

RG#58:ploting heatmap in map using maps package (US map example)

library(maps)
#get a state boundry map
usmap <- map("state", plot = FALSE, fill = TRUE)
dataf <- data.frame (states = usmap$names, yvar = abs(rnorm(length(usmap$names), 50,22)))

# define colors
colors <- topo.colors (6)
# categorize in different class for yvar
 dataf$colorBuckets <- as.numeric(cut(dataf$yvar, c(0, 30, 50, 70, 90, 130)))
# corresponding legend text
 legdtxt <- c("<0%", "0-30%", "30-50%", "50-70%", "70-90%", ">90%")

# plot map
  map("state", col = colors[dataf$colorBuckets], fill = TRUE, lty = 1, lwd = 0.2,    projection="polyconic")
  legend("topright", legdtxt, horiz = FALSE, fill = colors)

 # county level example
 # getting data
  require(mapproj)
  data(unemp)
  data(county.fips)

  # define color buckets
  colors = heat.colors(6)
  unemp$colorB <- as.numeric(cut(unemp$unemp, c(0, 2, 4, 6, 8, 10, 100)))
  legdtext <- c("<2%", "2-4%", "4-6%", "6-8%", "8-10%", ">10%")
 
 colorsmatched <- unemp$colorB [match(county.fips$fips, unemp$fips)]
  # draw map
  map("county", col = colors[colorsmatched], fill = TRUE, resolution = 0,
    lty = 0, projection = "polyconic")
   
  map("state", col = "white", fill = FALSE, add = TRUE, lty = 1, lwd = 0.2,
    projection="polyconic")
   
  title("US unemployment by county in year 2009")
 legend("topright", legdtext, horiz = FALSE, fill = colors)

RG#57: Heatmap plot of calender

 # data               
st <- as.Date("2010-2-17")
en <- as.Date("2013-4-7")
datell <- seq(st, en, "1 day")
myd <- data.frame (date1 = datell, heatvar = rnorm (length (datell), 50, 20))


# plot 
# using function written by Paul Bleicher
# requires lattice, chron, grid packages 

require(lattice)
require(chron)
require(grid)

source ("http://blog.revolution-computing.com/downloads/calendarHeat.R")
                
calendarHeat(myd$date1, myd$heatvar, varname="VAR name")

calendarHeat(myd$date1, myd$heatvar, varname="VAR name", ncolors=99,color="r2b" )

RG#56: heatmap plot of categorical variables

#data 
datf <- data.frame(indv=factor(paste("ID", 1:20),
    levels =rev(paste("ID", 1:20))), matrix(sample(LETTERS[1:7], 400, T), ncol = 20))



library(ggplot2); 
library(reshape2)
# converting data to long form for ggplot2 use

datf1 <- melt(datf, id.var = 'indv')

ggplot(datf1, aes(variable, indv)) + geom_tile(aes(fill = value),
   colour = "white")  +   scale_fill_manual(values= rainbow (7))

RG#44: Hexabin XY scatter plot and transparent point XY plot

# data
set.seed(1234)
x = rnorm(10000, 50, 30)
y = x*0.6 + rnorm (10000, 0, 30)
df <- data.frame(x,y)


ggplot(df,aes(x=x,y=y)) + stat_binhex() + theme_bw()

# vivid colored 
ggplot(df,aes(x=x,y=y)) + stat_binhex(colour="white",na.rm=TRUE) + scale_fill_gradientn(colours=c("green1","red"),name = "Frequency",na.value=NA)+ theme_bw()

# plot with transparency 
require(ggplot2)
ggplot(df,aes(x=x,y=y)) + geom_point(alpha = 0.3, col = "red") + theme_bw()

# in base

# data
set.seed(1234)
x = rnorm(10000, 50, 30)
y = x*0.6 + rnorm (10000, 0, 30)
df <- data.frame(x,y)


plot(df$x, df$y, pch = 19, cex = 1, col = rgb(0,1,0, alpha = 0.1))

# alpha function to introduce transparency
require(RColorBrewer)

add.alpha <- function(col, alpha=1){

  if(missing(col))

    stop("vector of colours missing")

  apply(sapply(col, col2rgb)/255, 2, 

                     function(x) 

                       rgb(x[1], x[2], x[3], alpha=alpha)) 

}

# POINT SIZE AND TRANSPARENCY 

plot (df$x, df$y, pch = 19, cex = 0.5, col = add.alpha ("red", 0.2))

RG#26: Plot of large number of data points (using IDPmisc)

# data 
x <- rnorm(100000, 50, 20)

y <-  x*0.6 + rnorm (100000, 0, 8)
y1 <- runif (100000, 0, 100)

#plot

require(IDPmisc) 

iplot(x, y)

iplot(x, y, pixs=2)

iplot(x = x, y = y1)

RG#22: heatmap plot using ggplot2

#data
set.seed(1234)
xm1 <- matrix(rnorm(100*10, rnorm(100, 0.5, 0.1)), nrow=100, ncol=10, byrow=FALSE)
xm2 <- matrix(rnorm(100*10, rnorm(100, 0.5, 0.1)), nrow=100, ncol=10, byrow=FALSE)
xm3 <- matrix(rnorm(100*10, rnorm(100, 0.5, 0.1)), nrow=100, ncol=10, byrow=FALSE)
dd <- cbind(xm1, xm2, xm3)

#heatmap plot
require(ggplot2)
# first need to reshape data to long form
require(reshape)
dd.melt <- data.frame(melt(dd) )
ggplot(dd.melt , aes(x=X1,y=X2, z= value)) + geom_tile(aes(fill= value)) + scale_fill_gradient(low="red", high="green") + theme_bw()