require(gridBase)

# This script from : http://www.r-project.org/misc/acpclust.R
ltitle <- function(x,backcolor="darkgreen",
forecolor="yellow",cex=2,ypos=0.4){
plot(x=c(-1,1),y=c(0,1),xlim=c(0,1),ylim=c(0,1),type="n",axes=FALSE)
polygon(x=c(-1,-1,1,1),y=c(-1,1,1,-1),col=backcolor,border=NA)
text(x=0,y=ypos,pos=4,cex=cex,labels=x,col=forecolor)
}

### Contoh Data
data <-
c(100,110,115,250,350,458,500,567,789,876,600,556,500,465,350,250,145)

data.axes <- c(0,200,400,600,800)

### Kelompok Umur
label <- c("0 – 4", "5 – 9", "10 – 14", "15 – 19", "20 – 24", "24 – 29","30 – 34", "35 – 39", "40 – 44", "44 – 49", "50 – 54", "55 – 59", "60 – 64","65 – 69", "70 – 74", "75 – 79", "80+")

mylayout=layout(matrix(c(1,1,2,3,4,5),ncol=2,byrow=T),widths=c(1/2,1/2),
heights=c(lcm(1),lcm(1),1))

# Judul Atas
par(mar = c(0.1, 0.8, 0.1, 0.1))
ltitle(paste("                                          
R Enciety – Piramida Penduduk"),cex=1.6,ypos=0.4)

# Judul Atas Kiri – Male
par(mar = c(0.1, 0.8, 0.1, 2))
ltitle(paste("                   
Laki-Laki"),cex=1.6,ypos=0.4,backcolor="white",
forecolor="darkgreen")

# Judul Atas Kanan – Female
par(mar = c(0.1, 0.8, 0.1, 0.5))
ltitle(paste("                   
Perempuan"),cex=1.6,ypos=0.4,backcolor="white",
forecolor="darkgreen")

### Plot Data Bagian Kiri
par(mar = c(5,1.5,1.5,5))
midpts <- barplot(-data,axes=F,horiz=T,col="blue",xlab="(dalam
ribu)")

axis(1,at=-data.axes,labels=FALSE)

# This script from R-News Vol 3/2, October 2003 by Paul Murrell
"Integrating grid Graphics output with Base Graphics Output".

vps <- baseViewports()
par(new=TRUE)
push.viewport(vps$inner,vps$figure,vps$plot)
grid.text(c(as.character(data.axes)),x=unit(-data.axes,"native"),
y=unit(-1,"lines"),rot=0)
pop.viewport(3)
par(new=FALSE)

### Plot Data Bagian Kanan

par(mar = c(5,2,1.5,4))
midpts <- barplot(data,axes=F,horiz=T,col="orange",xlab="(dalam
ribu)")

axis(2,at=midpts,labels=FALSE,col="white")
axis(1,at=data.axes,labels=FALSE)

# This script from R-News Vol 3/2, October 2003 by
Paul Murrell "Integrating grid Graphics output with Base Graphics
Output".


vps <- baseViewports()
par(new=TRUE)
push.viewport(vps$inner,vps$figure,vps$plot)
grid.text(c(as.character(data.axes)),x=unit(data.axes,"native"),
y=unit(-1,"lines"),rot=0)
pop.viewport(3)

vps <- baseViewports()
par(new=TRUE)
push.viewport(vps$inner,vps$figure,vps$plot)
grid.text(c(as.character(label)),y=unit(midpts,"native"),
x=unit(-2,"lines"),rot=0)
pop.viewport(3)

par(new=FALSE)

Grafik yang dihasilkan adalah sebagai berikut :