Итоговые статистики с графиками

Давно хотел сделать функцию, позволяющую добавлять маленькие графики к итоговым статистикам, и вот, наконец, сделал.

Вдохновлялся примером F. Harrell (используется LaTeX) и пакетом sparklines (для приложений shiny и простых html, просматриваемых в браузере).

Моя реализация этой идеи работает с rmarkdown (нужен пакет knitr) и оптимизирована для создания отчетов в .docx, пригодных для печати. Требуется: исходный файл .Rmd, папка "figures" в рабочей директории, установленный пакет psych. Функция работает с количественными переменными - как одиночными, так и совместно с функцией apply. Реализованы три типа графиков: боксплот, гистограмма и одномерная диаграмма рассеяния. Можно выбирать интересующие показатели описательной статистики из возвращаемых функцией describe{psych}, а также задать русский язык для названий столбцов в итоговой таблице (lang = "ru").

По мере сил буду дорабатывать, писать документацию по всем правилам и делать такую же функцию для категориальных переменных.

descGraph1 <- function(x, 
                       statistics = c(2:5, 8, 9), 
                       plot_type = "boxplot", 
                       height = 25, 
                       width = 100,
                       lang = "en") {
 
    # Created by Andrey Ogurtsov, 02.08.2015
 
    require(psych)
 
    # Filename
    fname <- tempfile(pattern = "graph", 
                      tmpdir = paste(getwd(), "figures", sep = "/"))
    fname <- unlist(strsplit(fname, "[\\]"))[2]
    fname <- paste("figures/", fname, ".png", sep = "")
 
    # Plot
    png(filename = fname, width = width, height = height)
    par(oma=c(0, 0, 0, 0), mar=c(0, 0, 0, 0), plt=c(0, 1, 0, 1), bty="n")
    if (plot_type == "boxplot") {
        boxplot(x, xaxt = "n", horizontal=TRUE) 
    } 
    if (plot_type == "hist") {
        hist(x, main="", yaxt = "n", breaks="FD") # Freedman-Diaconis rule
    }
    if (plot_type == "stripchart") {
    stripchart(x, xaxt = "n", method = "jitter", 
               jitter = 0.2, pch = 1, cex = 0.7)
    }
    dev.off()
 
    # Creating image link in markdown format
    imglink <- paste("![alt text](", fname, ")", sep="")
 
    # Final table
    tabl <- describe(x)[, statistics]
 
    # Rename columns
    if (lang == "ru") {
        ru_colnames <- c("Переменные", "n", "Среднее", "Станд. отклон.",
                         "Медиана", "Усеч. ср.", "Мед. абс. откл.",
                         "Мин.", "Макс.", "Размах", "Асимм.", "Эксцесс", 
                         "Станд. ош.")
        colnames(tabl) <- ru_colnames[statistics]
    }
 
    tabl$graph <- imglink
    colnames(tabl)[colnames(tabl) == "graph"] <- ""
 
    # unlink will not work with apply
 
    return(tabl)
}

Примеры использования:

kable(descGraph1(x=cars$speed, plot_type = "stripchart"))
kable(descGraph1(x=cars$speed, plot_type = "hist"))
 
result <- apply(cars, 2, descGraph1, lang="ru")
kable(do.call(rbind, result))

Результат в ворде выглядит следующим образом:

Гитхаб