Can we make this better?
As Prof. Carr suggests “We can do better in terms showing patterns a the cost of some visual entertainment appeal”.Let;s go step-by-step
*Using the values presented in the report to create tables:
dat <- c(22, 50, 8, 2, 13, 6, # White race, read clockwise
5, 24, 13, 24, 20, 15, # Black race, read clockwise
21, 33, 9, 7, 20, 9, # Hispanic race, read clockwise
24, 53, 4, 1, 12, 5) # Asian race, read clockwise
mat <- matrix(dat,ncol=6, byrow=TRUE)
race <- c("White","Black","Hispanic","Asian") #following the same order
type <- c( "Married, Father Working", "Married, Both Working",
"Divorced Mother","Never-married Mother","Other", "Grandparents")
dimnames(mat) <- list(race, type) #factor used as names
## Married, Father Working Married, Both Working Divorced Mother
## White 22 50 8
## Black 5 24 13
## Hispanic 21 33 9
## Asian 24 53 4
## Never-married Mother Other Grandparents
## White 2 13 6
## Black 24 20 15
## Hispanic 7 20 9
## Asian 1 12 5
This matrix is then transposed so each column will mirror the initial information of the original graph:
matType <- t(mat)
rm(mat)
## White Black Hispanic Asian
## Married, Father Working 22 5 21 24
## Married, Both Working 50 24 33 53
## Divorced Mother 8 13 9 4
## Never-married Mother 2 24 7 1
## Other 13 20 20 12
## Grandparents 6 15 9 5
Plotting
library(lattice)
dotplot(matType,groups=F, #data without grouping
layout=c(1,4),aspect=0.7, #4 rows, slim (not wide)
type=c("p","h"),main="Who is Raising the Children?", #dot and lines,title
xlab="Rounded Percents for Each Race May Not Total 100",
scales=list(x=list(tck=0, alternating=FALSE)),
panel=function(...){
panel.fill(rgb(.9,.9,.9))
panel.grid(h=0,v=-1,col="white",lwd=2)
panel.dotplot(col=rgb(0,153,0,maxColorValue = 255),cex=1.1,...)
}
)
Let's make some computations to get our graph ordered by mean value of each row:
rowMeans <- rowMeans(matType)
matTypeMeans <- cbind(matType, rowMeans)
ord <- order(rowMeans)
matTypeSort <- matType[ord, ] #omitting the means
## White Black Hispanic Asian
## Divorced Mother 8 13 9 4
## Never-married Mother 2 24 7 1
## Grandparents 6 15 9 5
## Other 13 20 20 12
## Married, Father Working 22 5 21 24
## Married, Both Working 50 24 33 53
Let's use that new matrix to update the previous plot, but using descending order:
dotplot(matTypeSort[, 4:1], groups = FALSE, layout = c(1, 4), aspect = 0.7,
origin = 0, type = c("p", "h"), main = "Who is Raising the Children?", xlab = "Rounded Family Percents By Race May Not Total 100",
scales = list(x = list(tck = 0, alternating = FALSE)), panel = function(...) {
panel.fill(rgb(0.9, 0.9, 0.9))
panel.grid(h = 0, v = -1, col = "white", lwd = 2)
panel.dotplot(col = rgb(0, 0, 255, maxColorValue = 255), cex = 1.1,
...)
})
Visually, we see that reordering the row groups will increase comparability:
ord <- c(2, 3, 4, 1)
matTypeFix <- matTypeSort[, ord]
dotplot(matTypeFix, groups = FALSE, layout = c(1, 4), aspect = 0.7, origin = 0,
type = c("p", "h"), main = "Who is Raising the Children?", xlab = "Rounded Family Percents By Race\nMany Not Total 100",
scales = list(x = list(tck = 0, alternating = FALSE)), panel = function(...) {
panel.fill(rgb(0.9, 0.9, 0.9))
panel.grid(h = 0, v = -1, col = "white", lwd = 2)
panel.dotplot(col = rgb(153, 76, 0, maxColorValue = 255), cex = 1.1,
...)
})
Improving ordering:
matRace <- t(matTypeFix)
dist <- dist(matRace)
points1D <- cmdscale(dist, k = 1)
matRaceFix <- matRace[order(points1D), ]
and…
barchart(matRaceFix, groups = FALSE, layout = c(1, 6), lwd = 2, origin = 0,
main = "Who is Raising the Children?", xlab = "Rounded Family Percents By Race\nMay Not Total 100",
scales = list(x = list(tck = 0, alternating = FALSE)), panel = function(...) {
panel.fill(rgb(0.9, 0.9, 0.9))
panel.grid(h = 0, v = -1, col = "white", lwd = 2)
panel.barchart(col = rgb(128, 255, 0, 50, maxColorValue = 255), cex = 1.1,
...)
})
raceMeans <- colMeans(matRaceFix)
windows(w = 4, h = 6.8)
## Error: could not find function "windows"
barchart(matRaceFix, groups = FALSE, layout = c(1, 6), main = "Who is Raising the Children?\n(red line represents mean)",
xlab = "Rounded Family Percents by Race\nMay Not Total 100", scales = list(x = list(tck = 0,
alternating = FALSE)), raceMeans = raceMeans, panel = function(...) {
panel.fill(rgb(0.9, 0.9, 0.9))
panel.grid(h = 0, v = -1, col = "white", lwd = 2)
i <- panel.number()
panel.abline(v = raceMeans[i], col = "red", lwd = 3, lty = 3)
panel.barchart(col = rgb(128, 255, 0, 50, maxColorValue = 255), cex = 1.1,
...)
})
two column?
ord <- c(4, 1, 5, 2, 6, 3)
barchart(matRaceFix[, ord], groups = FALSE, layout = c(2, 3), main = "Who is Raising the Children?\n(red line represents mean)",
xlab = "Rounded Family Percents by Race May Not Total 100", scales = list(x = list(tck = 0,
alternating = FALSE)), raceMeans = raceMeans, panel = function(...) {
panel.fill(rgb(0.9, 0.9, 0.9))
panel.grid(h = 0, v = -1, col = "white", lwd = 2)
i <- ord[panel.number()]
panel.abline(v = raceMeans[i], col = "red", lwd = 3)
panel.barchart(col = rgb(0, 0.5, 1), cex = 0.95, ...)
})
ord <- c(5, 3, 1, 6, 4, 2)
matRaceFix[, ord]
## Married, Father Working Grandparents Divorced Mother
## Black 5 15 13
## Hispanic 21 9 9
## White 22 6 8
## Asian 24 5 4
## Married, Both Working Other Never-married Mother
## Black 24 20 24
## Hispanic 33 20 7
## White 50 13 2
## Asian 53 12 1
barchart(matRaceFix[, ord], groups = FALSE, layout = c(3, 2), main = "Who is Raising the Children?\n(blue line represents mean)",
xlab = "Rounded Family Percents by Race May Not Total 100", scales = list(x = list(tck = 0,
alternating = FALSE)), raceMeans = raceMeans, panel = function(...) {
panel.fill(rgb(0.9, 0.9, 0.9))
panel.grid(h = 0, v = -1, col = "white", lwd = 2)
i <- ord[panel.number()]
panel.abline(v = raceMeans[i], col = "blue", lwd = 3, lty = 3)
panel.barchart(col = rgb(0, 102, 0, 50, maxColorValue = 255), cex = 0.95,
...)
})
