Создание кругового шлейфа с полым центром (ака по сюжету гоночной трассы)

Меня попросили воссоздать следующий стиль сюжета. (Пожалуйста, проигнорируйте вопрос о том, является ли это хорошим типом визуализации и любезно рассматривает это как добавление красочного элемента в числовую таблицу.)

Большая часть этого довольно проста, но я еще не нашел хорошего способа сделать центр полым. В интересах времени я могу прибегнуть к клоку добавления невидимых фиктивных данных (я опубликую этот подход, если никто другой не сделает этого, но он выглядит менее оптимальным, чем тот, который изменяет тему). Есть ли решение на основе темы или решение без ggplot2 R?

Что мы имитируем

Простой результат ggplot2 (нежелательный заполненный центр)

library(ggplot2)

# make sample dataframe

Category <- c("Electronics", "Appliances", "Books", "Music", "Clothing", 
            "Cars", "Food/Beverages", "Personal Hygiene", 
            "Personal Health/OTC", "Hair Care")
Percent <- c(81, 77, 70, 69, 69, 68, 62, 62, 61, 60)

internetImportance<-data.frame(Category,Percent)

# append number to category name
internetImportance$Category <-
     paste0(internetImportance$Category," - ",internetImportance$Percent,"%")

# set factor so it will plot in descending order 
internetImportance$Category <-
    factor(internetImportance$Category, 
    levels=rev(internetImportance$Category))

# plot

ggplot(internetImportance, aes(x = Category, y = Percent,
    fill = Category)) + 
    geom_bar(width = 0.9, stat="identity") + 
    coord_polar(theta = "y") +
    xlab("") + ylab("") +
    ylim(c(0,100)) +
    ggtitle("Top Product Categories Influenced by Internet") +
    geom_text(data = internetImportance, hjust = 1, size = 3,
              aes(x = Category, y = 0, label = Category)) +
    theme_minimal() +
    theme(legend.position = "none",
          panel.grid.major = element_blank(),
          panel.grid.minor = element_blank(),
          axis.line = element_blank(),
          axis.text.y = element_blank(),
          axis.text.x = element_blank(),
          axis.ticks = element_blank())

Как мы можем построить эти данные с полым центром?

Ответ 1

Здесь выполняется не-ggplot2 (базовое R-графическое) решение с использованием пакета plotrix, который содержит две приятные функции: draw.circle() и draw.arc():

circBarPlot <- function(x, labels, colors=rainbow(length(x)), cex.lab=1) {
  require(plotrix)
  plot(0,xlim=c(-1.1,1.1),ylim=c(-1.1,1.1),type="n",axes=F, xlab=NA, ylab=NA)
  radii <- seq(1, 0.3, length.out=length(x))
  draw.circle(0,0,radii,border="lightgrey")
  angles <- (1/4 - x)*2*pi
  draw.arc(0, 0, radii, angles, pi/2, col=colors, lwd=130/length(x), lend=2, n=100)
  ymult <- (par("usr")[4]-par("usr")[3])/(par("usr")[2]-par("usr")[1])*par("pin")[1]/par("pin")[2]
  text(x=-0.02, y=radii*ymult, labels=paste(labels," - ", x*100, "%", sep=""), pos=2, cex=cex.lab)
}

circBarPlot(Percent/100, Category)
text(0,0,"GLOBAL",cex=1.5,col="grey")

Это дает мне:

Ответ 2

Я думаю, что немедленное исправление заключается в создании некоторых "пустых" записей. Я бы создал internetImportance data.frame следующим образом:

Category <- c("Electronics", "Appliances", "Books", "Music", "Clothing", 
        "Cars", "Food/Beverages", "Personal Hygiene", 
        "Personal Health/OTC", "Hair Care")
Percent <- c(81, 77, 70, 69, 69, 68, 62, 62, 61, 60)

internetImportance <- data.frame(Category,Percent)

len <- 4
df2 <- data.frame(Category = letters[1:len], Percent = rep(0, len), 
                                 Category2 = rep("", len))
internetImportance$Category2 <- 
 paste0(internetImportance$Category," - ",internetImportance$Percent,"%")

# append number to category name
internetImportance <- rbind(internetImportance, df2)

# set factor so it will plot in descending order 
internetImportance$Category <-
    factor(internetImportance$Category, 
    levels=rev(internetImportance$Category))

И затем я нарисую ggplot2 с помощью fill=category2 следующим образом:

ggplot(internetImportance, aes(x = Category, y = Percent,
    fill = Category2)) + 
    geom_bar(width = 0.9, stat="identity") + 
    coord_polar(theta = "y") +
    xlab("") + ylab("") +
    ylim(c(0,100)) +
    ggtitle("Top Product Categories Influenced by Internet") +
    geom_text(data = internetImportance, hjust = 1, size = 3,
              aes(x = Category, y = 0, label = Category2)) +
    theme_minimal() +
    theme(legend.position = "none",
          panel.grid.major = element_blank(),
          panel.grid.minor = element_blank(),
          axis.line = element_blank(),
          axis.text.y = element_blank(),
          axis.text.x = element_blank(),
          axis.ticks = element_blank())

Это дает мне:

Вы можете добавить geom_text(label="GLOBAL", x=.5, y=.5, size=4) + до theme_minimal, чтобы добавить текст GLOBAL.

Ответ 3

Другое решение base, которое не полагается на пакет plotrix:

circular.barplot<-function(values, labels, col, cex){
    df<-data.frame(values=sort(values), labels=labels[order(values)])
    col<-col[order(values)]
    plot(NA,xlim=c(-1.3,1.3),ylim=c(-1.3,1.3),axes=F, xlab=NA, ylab=NA, asp=1)
    t<-sapply(df$values,function(x).5*pi-seq(0, 2*pi*x/100,length=1000))
    x<-sapply(1:nrow(df),function(x)(.3+x/nrow(df))*cos(t[,x]))
    y<-sapply(1:nrow(df),function(x)(.3+x/nrow(df))*sin(t[,x]))
    for(i in 1:nrow(df)){
        lines(x=x[,i],y=y[,i],col=col[i],lwd=10,lend=1)
        text(x[1,i],y[1,i],paste(df$labels[i]," - ",df$values[i],"%",sep=""),
             pos=2,cex=cex)
        }
    }

Ответ 4

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

Сначала данные:

Category <- c("Electronics", "Appliances", "Books", "Music", "Clothing", 
        "Cars", "Food/Beverages", "Personal Hygiene", 
        "Personal Health/OTC", "Hair Care")
Percent <- c(81, 77, 70, 69, 69, 68, 62, 62, 61, 60)
color = rainbow(length(Percent))

Переверните три вектора, так как circlize по умолчанию добавляет каждый элемент изнутри внутрь:

Category = rev(Category)
Percent = rev(Percent)
color = rev(color)

Если вы изображаете круг, это изогнутая область сюжета, то это просто добавление прямоугольников, линий и текстов.

library(circlize)

par(mar = c(1, 1, 1, 1))
circos.par("start.degree" = 90)
circos.initialize("a", xlim = c(0, 100)) # 'a` just means there is one sector
circos.trackPlotRegion(ylim = c(0.5, length(Percent)+0.5), track.height = 0.8, 
    bg.border = NA, panel.fun = function(x, y) {
    xlim = get.cell.meta.data("xlim") # in fact, it is c(0, 100)
    for(i in seq_along(Percent)) {
        circos.lines(xlim, c(i, i), col = "#CCCCCC")
        circos.rect(0, i - 0.45, Percent[i], i + 0.45, col = color[i], 
            border = "white")
        circos.text(xlim[2], i, paste0(Category[i], " - ", Percent[i], "%"), 
            adj = c(1, 0.5)) 
    }
})
circos.clear()

text(0, 0, "GLOBAL", col = "#CCCCCC")