Lorenz curves
x <- c(10, 10, 20, 20, 500, 560)
lc <- Lc(x)
plot(lc)
points(lc$p, lc$L, cex=1.5, pch=21, bg="white", col="black", xpd=TRUE)
Gini(x)
## [1] 0.7536
Gini(x, unbiased = FALSE)
## [1] 0.628
Gini(x, conf.level = 0.95)
## gini lwr.ci upr.ci
## 0.7536 0.2000 0.8968
Lineplots
m <- data.frame(lapply(d.pizza[,c("temperature","price","delivery_min","wine_ordered","weekday")]
, tapply, d.pizza$driver, mean, na.rm=TRUE))
(ms <- data.frame(lapply(m, scale))) # lets scale that
## temperature price delivery_min wine_ordered weekday
## Butcher 0.3606 -0.69917 -0.98047 -1.0738 1.9826
## Carpenter -1.5481 1.74806 1.54851 1.5445 0.1389
## Carter 0.6106 -0.82596 0.02841 -1.0840 -0.8062
## Farmer 0.7719 0.36563 -0.74842 0.6105 -0.7800
## Hunter 1.1473 -1.16829 -1.04738 -0.7793 -0.7038
## Miller -0.2919 0.52072 0.23662 0.3795 0.4597
## Taylor -1.0503 0.05902 0.96273 0.4027 -0.2912
x <- 1:ncol(ms)
y <- t(ms)
# windows(8.8,5)
par(mar=c(5,4,4,10)+.1)
matplot(x, y, type="l", col=rainbow(nrow(ms)), xaxt="n"
, las=1, lwd=2, frame.plot=FALSE, ylim=c(-2,2)
, xlab="", main="Horizontal profile")
abline(h=0, v=1:5, lty="dotted", col="grey")
par(xpd=TRUE)
legend(x=5.5, y=2, legend=rownames(ms), fill=rainbow(nrow(ms)))
axis(side=1, at=1:5, labels=colnames(ms), las=1, col="white")
Same on the x-axis
par(mar=c(8,8,5,2))
matplot(x=y, y=x, type="l", pch=1:5, frame.plot=FALSE, axes=FALSE, xlab="", ylab="", lty="solid"
, col=rainbow(nrow(ms)), xlim=c(-3,3), ylim=c(0.5,ncol(ms)), main="Driver's profile", lwd=2)
matpoints(x=y, y=x, col=rainbow(nrow(ms)), pch=16)
grid(ny=NA)
axis(side=1, las=1)
mtext(colnames(ms), side=2, at=1:ncol(ms), las=2)
par(xpd=TRUE)
legend(x=0, y=-1, legend=rownames(ms), fill=rainbow(nrow(ms)), xjust=0.5, ncol=4, cex=0.8)
“Bumpchart”
# example from plotrix (bumpchart)
edu <- matrix( c(90.4,90.3,75.7,78.9,66,71.8,70.5,70.4,68.4,67.9
,67.2,76.1,68.1,74.7,68.5,72.4,64.3,71.2,73.1,77.8)
, ncol=2, byrow=TRUE)
rownames(edu) <- c("Anchorage AK","Boston MA","Chicago IL","Houston TX"
,"Los Angeles CA","Louisville KY","New Orleans LA"
,"New York NY","Philadelphia PA","Washington DC")
colnames(edu) <- c(1990,2000)
par(mar=c(5,10,5,10))
matplot(x=1:2, y=t(edu), type="l", frame.plot=FALSE, axes=FALSE, xlab=""
, ylab="", lty="solid", col=rainbow(10))
matpoints(x=1:2, y=t(edu), pch=16, frame.plot=FALSE, axes=FALSE, xlab=""
, ylab="", lty="solid", col=rainbow(10))
sapply( 1:2, function(i) mtext(rownames(edu), side=2*i
, at=SpreadOut(edu[,i], mindist=1.1), line=1, las=1 ))
## [[1]]
## NULL
##
## [[2]]
## NULL
# in console, that generates error : # invalid graphics state
mtext(colnames(edu), side=3, at=1:2, line=-3.5, las=1 )
Barplot horizontal
# windows(height=3, width=11)
par(mfrow=c(1,2))
# tab?? Try `tab` defined later for circular plots:
tab <- matrix(c(2,5,8,3,10,12,5,7,15), nrow=3, byrow=FALSE)
dimnames(tab) <- list(c("A","B","C"), c("D","E","F"))
# A) , Error in col[1:2] : object of type 'closure' is not subsettable ??
barplot(tab, beside = TRUE, horiz=TRUE, main="A)"
, las = 1, legend = rownames(tab))
# B)
barplot(tab, beside = FALSE, horiz=TRUE, main="B)"
, las = 1, legend = rownames(tab))
# C) ptab??
# b <- barplot(ptab, beside = FALSE, horiz=TRUE, main="C)"
# , las = 1
# , legend.text = rownames(tab), args.legend = list(x=1, y=4.4, bg="white", ncol=2))
#
# text(paste(round(ptab[1,],3) * 100, "%",sep=""), x=ptab[1,]/2, y=b, col="white")
Barplot vertical
# windows(height=3, width=11)
# par(mfrow=c(1,3))
# A)
barplot(tab, beside = TRUE, main="A)" , legend = rownames(tab))
# B) , col = col
barplot(tab, beside = FALSE, main="B)"
, legend = rownames(tab))
# C) ptab??
# barplot(ptab, beside = FALSE, main="C)"
# , col = col, legend.text = rownames(tab)
# , args.legend = list(x=3.6, y=1.2, bg="white", ncol=2))
Barplot (specials)
# windows(height=3,11)
par(mfrow=c(1,3))
# A) Overlapping bars
blue <- rbind(c(5, 3, 4, 3) ,c(3, 2, 5, 1))
dimnames(blue) <- list(c("A","B"),c("t1","t2","t3","t4"))
red <- rbind(c(1.7,3.5,1.6,1.1)
, c(2.1,1.0,1.7,0.5))
dimnames(red) <- list(c("A","B"),c("t1","t2","t3","t4"))
# Set parameters
osp <- 0.5 # overlapping part in %
sp <- 1 # spacing between the bars
nbars <- dim(blue)[2] # how many bars do we have?
# Create first barplot
b <- barplot( blue, col=c("lightblue","blue"), main="A)"
, beside=FALSE, ylim=c(0,10), axisnames=FALSE
, xlim=c(0, nbars*2-osp ) # enlarge x-Axis
, space=c(0, rep(sp, nbars-1) ) # set spacing=1, starting with 0
)
# Draw the red series
barplot( red, col=c("salmon","red"), beside=FALSE
, space=c(1-osp, rep(1, nbars-1)) # shift to right by 1-osp
, axisnames=FALSE, add=TRUE)
# Create axis separately, such that labels can be shifted to the left
axis(1, labels=colnames(red), at=b+(1-osp)/2, tick=FALSE, las=1)
# B) Connecting lines
barplot(blue, col=c("lightblue","blue"), space=1.2, main="B)" )
ConnLines(blue, lwd=2, lty="dashed", space=1.2) # AddConnLines an early version of ConnLines??
# C) Add error bars
cred <- apply(red, 2, sum)
b <- barplot(cred, col=c("salmon"), space=1.2, ylim=c(0,5), main="C)" )
ErrBars(from=cred * .90, to=cred * 1.1, pos=b) # AddErrBars an early version of ErrBars??
PlotPyramid
d.sda <- data.frame(
kt_x = c("NW","TG","UR","AI","OW","GR","BE","SH","AG","BS","FR")
, apo_n = c(8, 11, 9, 7, 9, 24, 19, 19, 20, 43, 27 )
, sda_n = c(127, 125, 121, 121, 110, 48, 34, 33, 0, 0, 0 ))
PlotPyramid(lx=d.sda[,c("apo_n","sda_n")], ylab=d.sda$kt_x
, col=c("lightslategray", "orange2"), border = NA, ylab.x=0, xlim=c(-110,250)
, gapwidth = NULL, cex.lab = 0.8, cex.axis=0.8, xaxt = TRUE
, lxlab="Drugstores", rxlab="General practitioners"
, main="Density of general practitioners and drugstores"
, space=0.5, args.grid=list(lty=1))
## [,1]
## [1,] 1.0
## [2,] 2.5
## [3,] 4.0
## [4,] 5.5
## [5,] 7.0
## [6,] 8.5
## [7,] 10.0
## [8,] 11.5
## [9,] 13.0
## [10,] 14.5
## [11,] 16.0
Areaplot
t.oil <- t(matrix(c(13.3,11.4, 9.7,10.6,12.7,11.0,10.6,13.5
, 5.3, 3.6, 5.8, 8.4, 9.1,14.8,10.6, 9.6
, 4.9, 3.1, 3.0, 6.0,12.2, 7.1, 7.3,10.0
, 2.1, 2.6, 2.7, 3.5, 4.7, 5.0, 4.4, 4.3), nrow=4, byrow=TRUE
, dimnames = list(c("ExxonMobil","BP","Shell","Eni")
, c("1998","1999","2000","2001","2002","2003","2004","2005"))))
t(t.oil)
## 1998 1999 2000 2001 2002 2003 2004 2005
## ExxonMobil 13.3 11.4 9.7 10.6 12.7 11.0 10.6 13.5
## BP 5.3 3.6 5.8 8.4 9.1 14.8 10.6 9.6
## Shell 4.9 3.1 3.0 6.0 12.2 7.1 7.3 10.0
## Eni 2.1 2.6 2.7 3.5 4.7 5.0 4.4 4.3
par(mfrow=c(1,2)) # , mar=c(5,4,5,5) ??
col <- SetAlpha(PalHelsana(), 0.7)
PlotArea(t.oil, col = col, las = 1, frame.plot=FALSE)
mtext(side=4, text=colnames(t.oil), las=1 ) # at=Midx(tail(t.oil, 1), 0), ??
PlotArea(prop.table(t.oil, 1), col = col, las = 1, frame.plot=FALSE)
PercTable(t.oil, col.vars=1) # PercTable replaced a PropTable?
## 1998 1999 2000 2001 2002 2003 2004 2005
##
## ExxonMobil freq 13 11 9 10 12 11 10 13
## perc .055 .047 .040 .044 .052 .045 .044 .056
## BP freq 5 3 5 8 9 14 10 9
## perc .022 .015 .024 .035 .037 .061 .044 .040
## Shell freq 4 3 3 6 12 7 7 10
## perc .020 .013 .012 .025 .050 .029 .030 .041
## Eni freq 2 2 2 3 4 5 4 4
## perc .009 .011 .011 .014 .019 .021 .018 .018
Comparing distributions
PlotViolin(temperature ~ driver, data=d.pizza, col = SetAlpha(hblue,0.5)
, main="Temperature ~ Driver")
PlotMultiDens(temperature ~ driver, data=d.pizza, xlab="temperature"
, main="Temperature ~ Driver", panel.first=grid()
, col=PalHelsana(), lwd=2 )
stripchart(temperature ~ driver, d.pizza, vertical=TRUE
, method="jitter", pch=16, col=SetAlpha(hred,0.4))
d.frm <- na.omit(d.pizza[,c("temperature","driver")])
par(las=2, mar=c(4.1,10.1,5.1, 5.1))
cdplot(x=d.frm$temperature, y=d.frm$driver, ylab="", xlab="temperature"
, col=SetAlpha(PalHelsana(), 0.6))
