R Graphs: Creating Tufte's Horizontal Bar Lines

R graphs: Creating Tufte's horizontal bar lines

Not a big addition to @Andrie answer, but you can take an advantage of the package ggthemes to make Tufte-sque plots with ggplot2. Below, I'm using theme_tufte, change the font using extrafont package, and use opts to fine-tune all the other visual features:

library(ggthemes)
library(extrafont)
ggplot(msleep, aes(x=order)) + stat_bin(width=0.6, fill="gray") +
theme_tufte(base_family="GillSans", base_size=16, ticks=F) +
theme(axis.line=element_blank(), axis.text.x=element_blank(),
axis.title=element_blank()) +
geom_hline(yintercept=seq(5, 20, 5), col="white", lwd=1.2)

Sample Image

R: Connect bar graphs with lines filled in with matching bar color

This took some fiddling adjusting the width of the bars and the x-position of the area, but essentially geom_area(..., position = "fill") could take you pretty far. Alternatively you could also use position = "stack".

library(ggplot2)

set.seed(0)
data_bar <- data.frame(
stringsAsFactors = F,
Sample = rep(c("A", "B"), each = 10),
Percentage = runif(20),
Taxon = rep(1:10, by = 2)
)

ggplot(data_bar, aes(Sample, Percentage, fill = Taxon, group = Taxon)) +
geom_col(position = "fill", width = 0.5, colour = "black") +
geom_area(aes(x = c("A" = 1.25, "B" = 1.75)[Sample]),
position = "fill", colour = "black", alpha = 0.5,
outline.type = "both")

Sample Image

Created on 2021-02-16 by the reprex package (v1.0.0)

Alternative with stacking:

ggplot(data_bar, aes(Sample, Percentage, fill = Taxon, group = Taxon)) +
geom_col(position = "stack", width = 0.5, colour = "black") +
geom_area(aes(x = c("A" = 1.25, "B" = 1.75)[Sample]),
position = "stack", colour = "black", alpha = 0.5,
outline.type = "both")

Sample Image

Horizontal standard error bars on bar graphs with negative values

As @Jakub pointed out in his comment, SD values are positive values.

What you normally do is something like this:

library(ggplot2)
set.seed(1)

Behavior <- as.character(c(
"Hammock","Hammock",
"Climbing Trees","Climbing Trees",
"Structures","Structures",
"Grade","Grade"))
Presence <- c("Y","N","Y","N","Y","N","Y","N")
Mean <- as.numeric(
c("18.5", "-6.4",
"3.5","-6.8",
"13.2","-10.1",
"4.7","-2.3"))
SD <- as.numeric(c(
"17.6","-11.9",
"1.2","-4.4",
"3.6","-6.25",
"1.23","-0.4"))
my_sd <- runif(length(Behavior))
DF <- data.frame(Behavior,Presence,Mean,SD, my_sd)

brks <- seq(-20, 20, 2)

ggplot(DF,
aes(x=Behavior, y=Mean, fill=Presence )) +
geom_col() +
scale_y_continuous(breaks = brks) +
scale_fill_manual(values=c("#0b6bb6", "#6eaf46"),
name="",
breaks=c("N", "Y"),
labels=c("N", "Y")) +
coord_flip()+
theme_bw()+
xlab("Pen Characteristic - Behavior") +
ylab("Average Behavior per Session") +
geom_errorbar(aes(ymin=Mean - my_sd, ymax=Mean + my_sd))

R Using loop to create 4 separate graphs of matrices (using lines function)

From the link:

Relational Operators

Description

Binary operators which allow the comparison of values in atomic vectors.

Usage

x == y

Is it possible to split bars in barplot with R?

You can add horizontal lines on the whole picture: if they are white, and if the background is white, they will remain unnoticed.

barplot(VADeaths, beside=TRUE, las=1)
abline(h=0:100, col="white")
barplot(
VADeaths, beside=TRUE, las=1,
add=TRUE, col=FALSE
)

barplot

Functions available for Tufte boxplots in R?

You apparently wanted just a vertical version, so I took the panel.bwplot code, stripped out all the non-essentials such as the box and the cap, and set horizontal=FALSE in the arguments and created a panel.tuftebxp function. Also set the cex of the points at half of the default. There are still quite a few of options left that could be adjusted to your tastes. The "numeric" factor names for "Time" look sloppy but I figure the "proof of concept" is clear and you can clean up what is important to you:

panel.tuftebxp <- 
function (x, y, box.ratio = 1, box.width = box.ratio/(1 + box.ratio), horizontal=FALSE,
pch = box.dot$pch, col = box.dot$col,
alpha = box.dot$alpha, cex = box.dot$cex, font = box.dot$font,
fontfamily = box.dot$fontfamily, fontface = box.dot$fontface,
fill = box.rectangle$fill, varwidth = FALSE, notch = FALSE,
notch.frac = 0.5, ..., levels.fos = if (horizontal) sort(unique(y)) else sort(unique(x)),
stats = boxplot.stats, coef = 1.5, do.out = TRUE, identifier = "bwplot")
{
if (all(is.na(x) | is.na(y)))
return()
x <- as.numeric(x)
y <- as.numeric(y)
box.dot <- trellis.par.get("box.dot")
box.rectangle <- trellis.par.get("box.rectangle")
box.umbrella <- trellis.par.get("box.umbrella")
plot.symbol <- trellis.par.get("plot.symbol")
fontsize.points <- trellis.par.get("fontsize")$points
cur.limits <- current.panel.limits()
xscale <- cur.limits$xlim
yscale <- cur.limits$ylim
if (!notch)
notch.frac <- 0
#removed horizontal code
blist <- tapply(y, factor(x, levels = levels.fos), stats,
coef = coef, do.out = do.out)
blist.stats <- t(sapply(blist, "[[", "stats"))
blist.out <- lapply(blist, "[[", "out")
blist.height <- box.width
if (varwidth) {
maxn <- max(table(x))
blist.n <- sapply(blist, "[[", "n")
blist.height <- sqrt(blist.n/maxn) * blist.height
}
blist.conf <- if (notch)
sapply(blist, "[[", "conf")
else t(blist.stats[, c(2, 4), drop = FALSE])
ybnd <- cbind(blist.stats[, 3], blist.conf[2, ], blist.stats[,
4], blist.stats[, 4], blist.conf[2, ], blist.stats[,
3], blist.conf[1, ], blist.stats[, 2], blist.stats[,
2], blist.conf[1, ], blist.stats[, 3])
xleft <- levels.fos - blist.height/2
xright <- levels.fos + blist.height/2
xbnd <- cbind(xleft + notch.frac * blist.height/2, xleft,
xleft, xright, xright, xright - notch.frac * blist.height/2,
xright, xright, xleft, xleft, xleft + notch.frac *
blist.height/2)
xs <- cbind(xbnd, NA_real_)
ys <- cbind(ybnd, NA_real_)
panel.segments(rep(levels.fos, 2), c(blist.stats[, 2],
blist.stats[, 4]), rep(levels.fos, 2), c(blist.stats[,
1], blist.stats[, 5]), col = box.umbrella$col, alpha = box.umbrella$alpha,
lwd = box.umbrella$lwd, lty = box.umbrella$lty, identifier = paste(identifier,
"whisker", sep = "."))

if (all(pch == "|")) {
mult <- if (notch)
1 - notch.frac
else 1
panel.segments(levels.fos - mult * blist.height/2,
blist.stats[, 3], levels.fos + mult * blist.height/2,
blist.stats[, 3], lwd = box.rectangle$lwd, lty = box.rectangle$lty,
col = box.rectangle$col, alpha = alpha, identifier = paste(identifier,
"dot", sep = "."))
}
else {
panel.points(x = levels.fos, y = blist.stats[, 3],
pch = pch, col = col, alpha = alpha, cex = cex,
identifier = paste(identifier,
"dot", sep = "."))
}
panel.points(x = rep(levels.fos, sapply(blist.out, length)),
y = unlist(blist.out), pch = plot.symbol$pch, col = plot.symbol$col,
alpha = plot.symbol$alpha, cex = plot.symbol$cex*0.5,
identifier = paste(identifier, "outlier", sep = "."))

}
bwplot(weight ~ Diet + Time + Chick, data=cw, panel=
function(x,y, ...) panel.tuftebxp(x=x,y=y,...))

Sample Image



Related Topics



Leave a reply



Submit