2017-08-24 26 views
5

Moja firma chce robić raporty w R, chcą zachować tak dużo raportu Excel tak jak to możliwe. Czy jest jakiś sposób w ggplot2, aby utrzymać wygląd trójwymiarowy w Excelu? Ja chce zrobić wykres, który wygląda jak to, co jest poniżej:Grafika Excel z ggplot2

enter image description here

udało mi się zbliżyć. Oto, co mam do tej pory:

gender <- c("Male", "Male", "Female", "Male", "Male", "Female", "Male", "Male", "Female", "Male", 
          "Male", "Female") 
race <- c("African American", "Caucasian", "Hispanic", "African American", "African American", 
         "Caucasian", "Hispanic", "Other", "African American", "Caucasian", "African American", 
         "Other") 

data <- as.data.frame(cbind(gender, race)) 


gender_data <- data %>% 
    count(gender = factor(gender)) %>% 
    ungroup() %>% 
    mutate(pct = prop.table(n)) 


race_data <- data %>% 
    count(race = factor(race)) %>% 
    ungroup() %>% 
    mutate(pct = prop.table(n)) 


names(race_data)[names(race_data) == 'race'] <- 'value' 
names(gender_data)[names(gender_data) == 'gender'] <- 'value' 



# Function for fixing x axis that creeps into other values 
addline_format <- function(x,...){ 
    gsub('\\s','\n',x) 
} 

ggplot() + 
      geom_bar(stat = 'identity', position = 'dodge', fill = "#5f1b46", 
        aes(x = gender_data$value, y = gender_data$pct)) + 
      geom_bar(stat = 'identity', position = 'dodge', fill = "#3b6b74", 
        aes(x = race_data$value, y = race_data$pct)) + 
      geom_text(aes(x = gender_data$value, y = gender_data$pct + .03, 
         label = paste0(round(gender_data$pct * 100, 0), '%')), 
        position = position_dodge(width = .9), size = 5) + 
      geom_text(aes(x = race_data$value, y = race_data$pct + .03, 
         label = paste0(round(race_data$pct * 100, 0), '%')), 
        position = position_dodge(width = .9), size = 5) + 
      scale_x_discrete(limits = c("Male", "Female", "African American", "Caucasian", "Hispanic", "Other"), 
          breaks = unique(c("Male", "Female", "African American", "Caucasian", "Hispanic", 
              "Other")), 
          labels = addline_format(c("Male", "Female", "African American", "Caucasian", 
                "Hispanic", "Other"))) + 
      labs(x = '', y = '') + 
      scale_y_continuous(labels = scales::percent, 
        breaks = seq(0, 1, .2)) + 
      expand_limits(y = c(0, 1)) + 
      theme(panel.grid.major.x = element_blank() , 
       panel.grid.major.y = element_line(size=.1, color="light gray"), 
       panel.background = element_rect(fill = '#f9f3e5'), 
       plot.background = element_rect(fill = '#f9f3e5')) 

Dane wyjściowe są poniżej, w tym miejscu każda pomoc byłaby doceniana. Ja też trzeba umieścić spację między polami płeć i rasa, czy ktoś może pomóc w tym również:

enter image description here

+5

Możesz mieć więcej szczęścia w kratowaniu: https://stackoverflow.com/a/26822348/1412059 Ale kto chciałby odtworzyć tak okropny spisek? To tak, jakby jechać Teslą i chcieć mieć niebieską chmurę wychodzącą z tyłu. – Roland

+6

Nie pozwól, aby @hadley to zobaczył, może mieć tętniaka. – tkmckenzie

+5

[Moja Tesla z _green_ smoke] (https://stackoverflow.com/a/19943527/1851712). Przepraszamy za skrzywienie oczu @Roland, hadley .et al. Zobacz także [theme_excel] (https://cran.r-project.org/web/packages/ggthemes/vignettes/ggthemes.html) "_ dla tego klasycznego, brzydkiego wyglądu i stylu". – Henrik

Odpowiedz

4

Myślę, że wszyscy zgadzają się, że pseudo-3D wykresy Excel są dławik pełen problemów, ale Jestem sympatyczny z sytuacjami, w których trzeba pójść na kompromis z tymi, którzy podpisują wypłatę.

Ponadto potrzebuję lepszych hobby.

very ugly plot

Krok 1. Ładowanie & przekształcanie danych (czyli normalne rzeczy):

library(dplyr); library(tidyr) 

# original data as provided by OP 
gender <- c("Male", "Male", "Female", "Male", "Male", "Female", "Male", "Male", "Female", "Male", 
      "Male", "Female") 
race <- c("African American", "Caucasian", "Hispanic", "African American", "African American", 
      "Caucasian", "Hispanic", "Other", "African American", "Caucasian", "African American", 
      "Other") 
data <- as.data.frame(cbind(gender, race)) 

# data wrangling 
data.gather <- data %>% gather() %>% 
    group_by(key, value) %>% summarise(count = n()) %>% 
    mutate(prop = count/sum(count)) %>% ungroup() %>% 
    mutate(value = factor(value, levels = c("Male", "Female", "African American", 
              "Caucasian", "Hispanic", "Other")), 
     value.int = as.integer(value)) 

rm(data, gender, race) 

Krok 2. Zdefiniuj wielokąt współrzędne dla barów 3D-skutkowych (tj cringy rzeczy):

# top 
data.polygon.top <- data.gather %>% 
    select(key, value.int, prop) %>% 
    mutate(x1 = value.int - 0.25, y1 = prop, 
     x2 = value.int - 0.15, y2 = prop + 0.02, 
     x3 = value.int + 0.35, y3 = prop + 0.02, 
     x4 = value.int + 0.25, y4 = prop) %>% 
    select(-prop) %>% 
    gather(k, v, -value.int, -key) %>% 
    mutate(dir = str_extract(k, "x|y")) %>% 
    mutate(k = as.integer(gsub("x|y", "", k))) %>% 
    spread(dir, v) %>% 
    rename(id = value.int, order = k) %>% 
    mutate(group = paste0(id, ".", "top")) 

# right side 
data.polygon.side <- data.gather %>% 
    select(key, value.int, prop) %>% 
    mutate(x1 = value.int + 0.25, y1 = 0, 
     x2 = value.int + 0.25, y2 = prop, 
     x3 = value.int + 0.35, y3 = prop + 0.02, 
     x4 = value.int + 0.35, y4 = 0.02) %>% 
    select(-prop) %>% 
    gather(k, v, -value.int, -key) %>% 
    mutate(dir = str_extract(k, "x|y")) %>% 
    mutate(k = as.integer(gsub("x|y", "", k))) %>% 
    spread(dir, v) %>% 
    rename(id = value.int, order = k) %>% 
    mutate(group = paste0(id, ".", "bottom")) 

data.polygon <- rbind(data.polygon.top, data.polygon.side) 
rm(data.polygon.top, data.polygon.side) 

Krok 3. Wprowadzenie go razem:

ggplot(data.gather, 
     aes(x = value.int, group = value.int, y = prop, fill = key)) + 

    # "floor" of 3D panel 
    geom_rect(xmin = -5, xmax = 10, ymin = 0, ymax = 0.02, 
      fill = "grey", color = "black") + 

    # background of 3D panel (offset by 2% vertically) 
    geom_hline(yintercept = seq(0, 1, by = 0.2) + 0.02, color = "grey") + 

    # 3D effect on geom bars 
    geom_polygon(data = data.polygon, 
       aes(x = x, y = y, group = group, fill = key), 
       color = "black") + 

    geom_col(width = 0.5, color = "black") + 
    geom_text(aes(label = scales::percent(prop)), 
      vjust = -1.5) + 
    scale_x_continuous(breaks = seq(length(levels(data.gather$value))), 
        labels = levels(data.gather$value), 
        name = "", expand = c(0.2, 0)) + 
    scale_y_continuous(breaks = seq(0, 1, by = 0.2), 
        labels = scales::percent, name = "", 
        expand = c(0, 0)) + 
    scale_fill_manual(values = c(gender = "#5f1b46", 
           race = "#3b6b74"), 
        guide = F) + 
    facet_grid(~key, scales = "free_x", space = "free_x") + 
    theme(panel.spacing = unit(0, "npc"), #remove spacing between facets 
     strip.text = element_blank(), #remove facet header 
     axis.line = element_line(colour = "black", linetype = 1), 
     panel.grid.major = element_blank(), 
     panel.grid.minor = element_blank(), 
     panel.background = element_rect(fill = '#f9f3e5'), 
     plot.background = element_rect(fill = '#f9f3e5')) 

Uwaga: Jeśli zakomentuj geom_rect()/geom_hline()/geom_polygon() geoms & przestać ukrywać odstępy aspekt/nagłówek w theme(), to byłoby prawie reprezentacyjny ...

+0

@Iwwanabe: Czy odpowiedź Z.Lin rozwiązała twoje pytanie? Rozważ zaakceptowanie odpowiedzi (przełącz znacznik wyboru na lewo od odpowiedzi), aby potwierdzić wysiłki tego plakatu. – CPak

+0

Mam błąd: Błąd w gather (.): Nie można znaleźć funkcji "gather" Moja wersja dplyr to 0.7.2 w zakładce paczki. Nie jestem pewien, czy to jest problem, czy nie. Dziękuję za odpowiedź na moje pytanie. Wdroży Twoje rozwiązanie tak dobrze jak potrafię. –

+0

@IwannabeTheguy: Przepraszam, 'gather()' pochodzi z pakietu tidyr, część hadley's [tidyverse] (https://www.tidyverse.org/) wraz z dplyr. Zaktualizuje mój kod. –