Функции, доступные для ящиков Tufte в R?

У меня есть некоторые данные, которые я разделил на достаточное количество групп, которые выглядят очень многолюдно. У Tufte есть свои собственные ящики, в которых вы в основном бросаете все или половину коробки, например:

Некоторые примеры данных:

cw <- transform(ChickWeight, 
  Time = cut(ChickWeight$Time,4)
  )
cw$Chick <- as.factor( sample(LETTERS[seq(3)], nrow(cw), replace=TRUE) )
levels(cw$Diet) <- c("Low Fat","Hi Fat","Low Prot.","Hi Prot.")

Я хочу коробку веса для каждой диеты * Время * Группировка цыпленка.

У меня возникла эта проблема много лет назад, и я смешал решение с использованием сетчатой графики, которую я опубликую немного. Но в решении этой новой (и аналогичной) проблемы я задаюсь вопросом, есть ли способ запасать их, а не фиксировать мой пример с совпадением.

В стороне они кажутся одними из менее любимых творений Tufte, но мне они очень нравятся для плотного отображения шаблонов распределений по многочисленным группировкам, и я бы использовал их больше, если бы была хорошая функция для них в ggplot2 или решетке.

Ответ 1

Вы, по-видимому, хотели только вертикальную версию, поэтому я взял код panel.bwplot, убрал все несущественные предметы, такие как поле и кепку, и установил в аргументах horizontal = FALSE и создал функцию panel.tuftebxp, Также установите cex точек в половине значения по умолчанию. Осталось еще немало вариантов, которые можно было бы подгонять под ваши вкусы. "Числовые" имена факторов для "Время" выглядят неряшливо, но я полагаю, что "доказательство концепции" ясно, и вы можете очистить то, что важно для вас:

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,...))

Ответ 2

Вот решение без использования каких-либо пакетов, просто манипулируя графическими параметрами boxplot pars. Мое предложение ближе всего к @DWin, но избавляется от цвета и осей и использует лишь несколько строк кода. Оба предложения от @gsk3 и @Ramnath очень хороши и гораздо более продвинуты, чем у меня, но если я могу прокомментировать - они не могут обратиться к основной философии Tufte. Если бы мы избавились от серого фона, белых "тюремных баров" и ненужных цветов, все вышеперечисленные решения получили бы ясность, простоту и правильность баланса данных.

Кредиты должны поступать создателям PerformanceAnalytics, которые включали симпатичную оболочку chart.Boxplot, вдохновленную работой Tufte. Я просто извлек некоторые элементы функции, чтобы сделать его еще проще. Просто приложите данные 'cw' выше из @gsk3.

attach(cw)
par(mfrow=c(1,3))
boxplot(weight~Time, horizontal = F, main = "", xlab="Time", ylab="Weight", 
        pars = list(boxcol = "white", medlty = "blank", medpch=16, medcex = 1.3, 
        whisklty = c(1, 1), staplelty = "blank", outcex = 0.5), axes = FALSE)
axis(1,at=1:4,label=c(1:4))
axis(2)
boxplot(weight~Chick, horizontal = F, main = "", xlab = "Chick", 
        ylab = "", pars = list(boxcol = "white", medlty = "blank", medpch=16, 
        medcex = 1.3, whisklty = c(1, 1), staplelty = "blank", outcex = 0.5), 
        axes = FALSE)
axis(1,at=1:3,label=c("A","B","C"))
boxplot(weight~Diet, horizontal = F, main = "", xlab = "Diet", ylab = "", 
        pars = list(boxcol = "white", medlty = "blank", medpch=16, medcex = 1.3, 
        whisklty = c(1, 1), staplelty = "blank", outcex = 0.5), axes = FALSE)
axis(1,at=1:4,label=c("LoFat","HiFat","LoProt","HiProt"))

Ответ 3

Вот обычное решение ggplot (или, скорее, взломать область видимости)

require(ggplot2)

# melt the data frame
cw2 = melt(cw, id = 'weight')

# create a data frame with boxplot stats
cw3 = ddply(cw2, .(value, variable), function(df) boxplot.stats(df$weight)$stats)

# generate the plot
ggplot(cw2, aes(value, weight)) +
  geom_boxplot(fill = 'gray90', colour = 'gray90', alpha = 0) +      
  geom_segment(data = cw3, aes(xend = value, y = V1, yend = V2)) + 
  geom_segment(data = cw3, aes(xend = value, y = V4, yend = V5)) + 
  geom_point(data = cw3, aes(y = V3), size = 3) + 
  facet_wrap(~ variable, scales = 'free_x', nrow = 1)

Ответ 4

Здесь моя очень глухая функция для этого. К сожалению, хотя он ссылается на panel.tuftebox, я написал этот код в течение первых нескольких месяцев обучения R по очень конкретной цели (и, к сожалению, без намерения его обобщить), и поэтому он никогда не был написан как отдельный панели.

library(lattice)
library(taRifx)
compareplot(~weight | Diet * Time * Chick, 
  data.frame=cw , 
  main = "Chick Weights",
  box.show.mean=FALSE,
  box.show.whiskers=FALSE,
  box.show.box=FALSE
  )

Ответ 5

Есть функции для создания нескольких графиков в стиле Tufte в пакете ggthemes Джеффри Арнольд, доступный на github. Пакет представляет собой кучу тем для ggplot и включает в себя:

geom_tufterangeframe: Рамка диапазона Tufte

geom_tufteboxplot: Строка окна Tufte

theme_tufte: минимальная чернила на основе Tufte. Визуальный дисплей количественной информации.

Ниже приведен пример минимального квадрата ящика Tufte из пакета README на github: