私の会社はRでレポートを作成したいと考えており、Excelレポートをできるだけ同じに保ちたいと考えています。ggplot2に、Excelで得られる安っぽい3Dの外観を維持する方法はありますか?以下のようなプロットを作成したいと思います。
私は近づくことができました。これが私がこれまでに持っているものです:
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'))
出力は以下のとおりです。この時点で、助けていただければ幸いです。また、誰かがそれを手伝ってくれるなら、性別と人種のフィールドの間にスペースを入れる必要があります:
Excelの疑似3Dグラフは問題でいっぱいだということには誰もが同意していると思いますが、給料に署名する人と妥協しなければならない状況には共感します。
また、もっと趣味が必要です。
ステップ1.データ(つまり通常のもの)のロードと再形成:
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)
ステップ2.3Dエフェクトバー(つまり、歯ごたえのあるもの)のポリゴン座標を定義します。
# 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)
ステップ3.それをまとめる:
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'))
注:geom_rect()
/ geom_hline()
/ geom_polygon()
geomsをコメントアウトし、ファセット間隔/ヘッダーを非表示にするのをやめるとtheme()
、これはほとんど見栄えがします...
この記事はインターネットから収集されたものであり、転載の際にはソースを示してください。
侵害の場合は、連絡してください[email protected]
コメントを追加