RG#103: Combing different types of plot in trellis type

require(lattice)

require(latticeExtra)

#xy plot, conditioned from quakes data, with histogram 
qk <- xyplot(lat ~ long | equal.count(depth, 2), quakes,
    aspect = "iso", pch = "+", cex = 1.5, xlab = NULL, ylab = NULL)
qk <- c(qk, depth = histogram(quakes$depth), layout = c(3, 1))

update(qk, scales = list(at = list(NA, NA, NA, NA),
                          y = list(draw = FALSE)))





# suppress scales on the first 2 panels
update(qk, scales = list(at = list(NULL, NULL, NA),
                          y = list(draw = FALSE)))

RG#102: Double Y axis trellis plot (weather data example)

require(latticeExtra)

require (lattice)

data(SeatacWeather)

tempatures <- xyplot(min.temp + max.temp ~ day | month,
               data = SeatacWeather, type = "l", layout = c(3, 1))
rainfall <- xyplot(precip ~ day | month, data = SeatacWeather, type = "h", lwd = 4)

doubleYScale(tempatures, rainfall, style1 = 0, style2 = 3, add.ylab2 = TRUE,
   text = c("min. T", "max. T", "rain"), columns = 3)

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#53: Trellis plot in Box-Percentile Panel

set.seed(13)
x <- c(rnorm(1000, 50, 20), rnorm(500, 70, 10), rnorm(500, 30, 10), runif(1000, 0, 100))
g <- rep (c("normal", "binormal", "uniform"), each = 1000)

# default trellis box plot
require(lattice)

#regular box plot  
bwplot(g ~ x, col = "red", fill = c("cyan4", "tan", "blue"))


# box-percentile plot with data density (rug plot)
bwplot(g ~ x, panel=panel.bpplot, probs=seq(.01,.49,by=.01), datadensity=TRUE,

col = "red" )

# continuous plot up until quartiles ("Tootsie Roll plot")
bwplot(g ~ x, panel=panel.bpplot, probs=seq(.01,.25,by=.01))

# start at quartiles then make it continuous ("coffin plot")
bwplot(g ~ x, panel=panel.bpplot, probs=seq(.25,.49,by=.01))

# same as previous but add a spike to give 0.95 interval
bwplot(g ~ x, panel=panel.bpplot, probs=c(.025,seq(.25,.49,by=.01)))

# decile plot with reference lines at outer quintiles and median
bwplot(g ~ x, panel=panel.bpplot, probs=c(.1,.2,.3,.4), qref=c(.5,.2,.8))

# prototype of bplot 

bpplt()

RG#38: Stacked bar chart (number and percent)

myd <- data.frame(   var1  = c(1,1,2,2,3,3,4,4),  
samp = c("A","B","A","B","A","B","A","B"),  
Value1 = c(3.5,2,5,8,3,2,7,2), Value2 = c(1.5,0,5,5,3,0,4,5) )
# rshaping data to long form for ggplot2
library(reshape2)
meltd<- melt(myd, id.vars=1:2)

#plot
library(ggplot2)
ggplot(meltd, aes(x=var1, y=value, fill=variable)) +
  geom_bar(stat="identity") + facet_grid(~samp) + theme_bw()

# stacked percent
library (scales) 
ggplot(meltd, aes(x=var1, y=value, fill=variable)) +
geom_bar(stat="identity", position = "fill") +
scale_y_continuous(labels = percent_format())+
   facet_grid(~samp) + theme_bw()

 

RG#36: Multiple scatter plots of trallis type

 set.seed(1234)
X <- rnorm (480, 10,5)
myd <- data.frame (X1 = rep (c("A", "B", "C", "D"), each = 120), X2 = rep (rep(rep(c("E", "F"), 4), each = 30), 4), X3 = X, Y = X*0.5 + rnorm (length (X), 0, 4)) 


# need ggplot2
library(ggplot2)


qplot(X3, Y, data=myd, facets=X1~X2, xlab="X1 (units)", ylab="Y1 (units)") + theme_bw()      

 


# add regression lines
qplot(X3, Y, data=myd, facets=X1~X2, xlab="X1 (units)", ylab="Y1 (units)", geom=c("point", "smooth"), method="lm", formula= y~x) + theme_bw()

 

RG#8: multiple arranged error bar plot (trallis type)

 # multiple arranged error bar plot (trallis type)
#data
env <- c(rep("E1", 9), rep("E2", 9))
trt <- c(rep (c("A101", "B234", "c777"), each = 3))
group <- c(rep (1:3, 6))
yld <- c(3,4,6, 3,8,4, 1,2,6, 3,4,5, 6,7,7, 1,4,8)
se <- c(0.3, 0.6, 0.3, 0.6, 0.1, 0.9, 0.21, 0.4,
    0.5, 0.2, 0.1, 0.3, 0.4, 0.2, 0.3, 0.4, 0.4, 0.3)
dataf <- data.frame (env, trt, group, yld, se)
limits <- aes(ymax = yld + se, ymin=yld - se)


# using ggplot2
require(ggplot2)
plt1 <- ggplot(dataf, aes(fill=factor(group), y=yld, x=trt))
plt1 + geom_bar(position= position_dodge(width=0.9)) +
geom_errorbar(limits, position= position_dodge(width=0.9), width=0.8) +
theme_bw( ) + facet_grid(.~env)

 

RG #3: multiple scatter plot with smoothed line (trellis plots)

# data 

set.seed (12345)

y1 <- rnorm(1000, 12,9)

x1 <- 0.35 *y1 + rnorm(1000, 0,3)

x2 <-  c(rep("A",500), rep("B",500))

x3 <-  c(rep(1,100), rep(2,100), rep(3,100), rep(4,100), rep(5, 100), rep(1,100), rep(2,100), rep(3,100), rep(4,100), rep(5, 100))

data2 <- data.frame(x1, y1, x2, x3)

require(ggplot2) 

# scatter plots with out lines 

qplot(y1, x1, data =data2) + facet_grid(x2 ~ x3)+theme_bw()

# with smoothed lines  

qplot(y1, x1, data =data2, geom = c("point", "smooth"), method = "lm") + facet_grid(x2 ~ x3)+ theme_bw()