knitr::opts_chunk$set(echo = TRUE, warning = FALSE, message = FALSE)
自然數(shù)轉(zhuǎn)為比例
語(yǔ)法
rescale(x, to = c(0, 1), from = range(x, na.rm = TRUE, finite = TRUE), ...)
參數(shù)
x：continuous vector of values to manipulate. 要操作的數(shù)值向量
to： output range (numeric vector of length two) 輸出范圍
from：input range (vector of length two). If not given, is calculated from the range of x 輸入范圍世吨，默認(rèn)為x的范圍
... ：other arguments passed on to methods
例子
library(scales)
x <- c(127.31, 5787.47, 3703.58, 78.61)
#轉(zhuǎn)成（0,1)區(qū)間，輸入范圍為 [0韵吨，sum(x)] ，實(shí)際上算的是各值占比。
rescale(x, to=c(0,1), from=c(0,sum(x)))
#轉(zhuǎn)成（0途事，100）區(qū)間
rescale(x, to=c(0,100), from=c(0,sum(x)))
小數(shù)點(diǎn)轉(zhuǎn)成百分比
語(yǔ)法
percent(x, accuracy = NULL, scale = 100, prefix = "",
suffix = "%", big.mark = " ", decimal.mark = ".", trim = TRUE,
...)
參數(shù)
accuracy: Number to round to, NULL for automatic guess. 數(shù)值精確度萍膛。不設(shè)置吭服，函數(shù)會(huì)自動(dòng)判斷 設(shè)定小數(shù)位。
scale：A scaling factor: x will be multiply by scale before formating (useful if the underlying data is on another scale, e.g. for computing percentages or thousands). 刻度卦羡，默認(rèn)為100噪馏。
prefix, suffix：Symbols to display before and after value. 前綴，后綴绿饵。后綴默認(rèn)為%
big.mark：Character used between every 3 digits to separate thousands. 大數(shù)的分隔符欠肾。
decimal.mark：The character to be used to indicate the numeric decimal point. 小數(shù)點(diǎn)的分隔符。
trim：Logical, if FALSE, values are right-justified to a common width 修剪拟赊，默認(rèn)為TRUE刺桃。如果是FALSE，值右對(duì)齊到一個(gè)公共寬度（所有值等寬）吸祟。如果是TRUE瑟慈，值的前導(dǎo)空格就會(huì)刪除。
percent(rescale(x, to=c(0,1), from=c(0,sum(x[1:4]))))
[1] "0%" "17%" "33%" "50%" "67%" "83%" "100%" "117%" "133%" "150%" "167%" "833%"
percent(rescale(x, to=c(0,1), from=c(0,sum(x[1:4]))), trim=FASLE)
[1] " 0%" " 17%" " 33%" " 50%" " 67%" " 83%" "100%" "117%" "133%" "150%" "167%" "833%"
例子
#不保留小數(shù)位
percent(rescale(x, to=c(0,1), from=c(0,sum(x[1:4]))), accuracy = 1)
#保留兩位小數(shù)
percent(rescale(x, to=c(0,1), from=c(0,sum(x[1:4]))), accuracy = .01)
中國(guó)老年人婚姻狀況變化
library(reshape2)
library(tidyverse)
library(scales)
# 錄入數(shù)據(jù)屋匕，并整理成數(shù)據(jù)框
marriage <- c("未婚","有配偶","喪偶","離婚")
y1990 <- c(127.31, 5787.47, 3703.58, 78.61)
y2000 <- c(212.17, 8616.39, 3885.58,84.26)
y2010 <- c(313.68, 12459.03, 4747.92, 138.08)
marriage2 <- data.frame(marriage, y1990, y2000, y2010)
marriage3 <- melt(marriage2, id.vars="marriage", variable.name="year", value.name="population")
marriage3$marriage <- factor(marriage3$marriage, levels= c("未婚","有配偶","喪偶","離婚"), c("未婚","有配偶","喪偶","離婚"))
marriage3$year <- str_replace(marriage3$year,"y","")
#根據(jù)人數(shù)葛碧，計(jì)算比例
y1990p <- percent(rescale(y1990, to =c(0,1), from=c(0,sum(y1990))),accuracy=.01, suffix = "")
y2000p <- percent(rescale(y2000, to =c(0,1), from=c(0,sum(y2000))),accuracy=.01, suffix = "")
y2010p <- percent(rescale(y2010, to =c(0,1), from=c(0,sum(y2010))),accuracy=.01, suffix = "")
marriage_P <- data.frame(marriage, y1990p, y2000p, y2010p)
marriage_P2 <- melt(marriage_P, id.vars="marriage", variable.name = "year", value.name = "percent")
marriage_P2$marriage <- factor(marriage_P2$marriage, levels= c("未婚","有配偶","喪偶","離婚"), c("未婚","有配偶","喪偶","離婚"))
#刪除year值中的"y"和“p"，只提取年份过吻。
marriage_P2$year <- str_sub(marriage_P2$year, 2,5)
# 不知道為什么进泼，如果直接把marriage_P2整個(gè)表合并進(jìn)來(lái)，不會(huì)改變?cè)兞康臄?shù)據(jù)類型纤虽。但是如果只合并marriage_P2$percent,會(huì)改變percent變量的數(shù)據(jù)類型乳绕，變成因子型。
marriage4 <- cbind(marriage3, marriage_P2$percent)
names(marriage4)[4] <- "percent"
#因子型 轉(zhuǎn)數(shù)值型逼纸，不能直接轉(zhuǎn)洋措，一定要先轉(zhuǎn)成字符型，再轉(zhuǎn)成數(shù)值型杰刽。
marriage4$percent <- as.numeric(as.character(marriage4$percent))
library(ggplot2)
ggplot(marriage4, aes(x=year, y=percent, group=marriage) ) +
geom_col(aes(fill=marriage), position="dodge") +
geom_text(aes(label=percent, y= percent+0.5), position = position_dodge(width = 0.9), vjust=0) +
labs(x=NULL, y=NULL, fill="婚姻類型", title="比例變化圖") +
theme(legend.position = c(0.8, 0.8))
ggplot(marriage4, aes(x=year, y=population, group=marriage)) +
geom_line(aes(colour=marriage), size=2) +
geom_point(aes(shape=marriage),size=2) +
facet_wrap(.~marriage, scales="free") +
labs(x=NULL, y="人口數(shù)（萬(wàn)人）", title="人口變化圖") +
theme(legend.position = "none")
拼圖
拼圖包常用有三個(gè)：
- gridExtra包的grid.arrange()函數(shù)
- ggpubr包的ggarange()函數(shù)
- cowplot包的ggdraw()+draw_plot()函數(shù)
參見:
library(cowplot)
p1<- ggplot(marriage4, aes(x=year, y=percent, group=marriage) ) +
geom_col(aes(fill=marriage), position="dodge") +
geom_text(aes(label=percent, y= percent+0.5), position = position_dodge(width = 0.9), vjust=0) +
labs(x=NULL, y="比例(%)", fill="婚姻類型") +
theme(legend.position = c(0.92, 0.85), legend.background = element_blank())
p2 <- ggplot(marriage4, aes(x=year, y=population, group=marriage)) +
geom_line(aes(colour=marriage), size=2) +
geom_point(aes(shape=marriage),size=2) +
facet_wrap(.~marriage, scales="free") +
labs(x=NULL, y="人口數(shù)（萬(wàn)人）") +
theme(legend.position = "none")
ggdraw() +
draw_plot(p1, 0,0.1,0.5,0.85) +
draw_plot(p2, 0.5,0.1,0.5,0.85) +
draw_plot_label(c("比例圖","人口圖"),x=c(0,0.5), y=c(1,1)) +
draw_plot_label("數(shù)據(jù)來(lái)源：中國(guó)人口普查 制圖：李亮", x=0.63, y=0.1, size=8)
- ggdraw() 在ggplot圖的上面調(diào)協(xié) 一個(gè)繪圖層菠发。
- draw_plot(plot, x = 0, y = 0, width = 1, height = 1, scale = 1,
hjust = 0, vjust = 0) 在ggdraw畫布上的某個(gè)地方放置一個(gè)plot圖- (0, 0, 0.5, 1) 左半圖王滤；(0.5, 0, 0.5, 1) 右半圖
- (0, 0.5 , 1, 0.5) 上半圖；(0, 0, 1, 0.5) 下半圖
- draw_plot_label(label, x = 0, y = 1, hjust = -0.5, vjust = 1.5,
size = 16, fontface = "bold", family = NULL, color = NULL,
colour, ...) 給圖添加標(biāo)簽雷酪。
程序改進(jìn)
利用通道分組計(jì)算新值淑仆。
marriage <- c("未婚","有配偶","喪偶","離婚")
y1990 <- c(127.31, 5787.47, 3703.58, 78.61)
y2000 <- c(212.17, 8616.39, 3885.58,84.26)
y2010 <- c(313.68, 12459.03, 4747.92, 138.08)
marriage2 <- data.frame(marriage, y1990, y2000, y2010)
marriage3 <- melt(marriage2, id.vars="marriage", variable.name="year", value.name="population")
marriage3$marriage <- factor(marriage3$marriage, levels= c("未婚","有配偶","喪偶","離婚"), c("未婚","有配偶","喪偶","離婚"))
marriage3$year <- str_replace(marriage3$year,"y","")
# 按year分組，計(jì)算各婚姻類別人口占某一year組人口的百分比哥力。
marriage3 <- marriage3 %>%
group_by(year) %>%
mutate(percent= percent(rescale(population, to= c(0,1), from=c(0,sum(population))), accuracy=0.01, suffix=""))
marriage3
合并數(shù)據(jù)框時(shí)應(yīng)注意數(shù)據(jù)類型
y1990p <- percent(rescale(y1990, to =c(0,1), from=c(0,sum(y1990))),accuracy=.01, suffix = "")
y2000p <- percent(rescale(y2000, to =c(0,1), from=c(0,sum(y2000))),accuracy=.01, suffix = "")
y2010p <- percent(rescale(y2010, to =c(0,1), from=c(0,sum(y2010))),accuracy=.01, suffix = "")
# 注意percent轉(zhuǎn)化出來(lái)的是字符型列表
# 注意字符型列表轉(zhuǎn)成數(shù)據(jù)框時(shí)蔗怠，默認(rèn)會(huì)變成因子，給后面數(shù)據(jù)處理帶來(lái)麻煩吩跋。因此要加參數(shù)stringsAsFactors=FALSE
marriage_P <- data.frame(marriage, y1990p, y2000p, y2010p, stringsAsFactors=FALSE)
marriage_P2 <- melt(marriage_P, id.vars="marriage", variable.name = "year", value.name = "percent")
marriage_P2 <- as_tibble(marriage_P2)
marriage_P2
# 注意melt()函數(shù)在數(shù)據(jù)框轉(zhuǎn)置時(shí)measure.vars變成的新變量是因子型寞射，如本例中的year
# 使用tidyr包中的gather()函數(shù), 默認(rèn)factor_key = FALSE, 即Key值被存為字符型。如果TRUE锌钮，則存為因子型桥温。
marriage_P <- data.frame(marriage, y1990p, y2000p, y2010p, stringsAsFactors=FALSE)
marriage_P2 <- gather(marriage_P, key = "year", value = "percent", - marriage)
marriage_P2 <- as_tibble(marriage_P2)
marriage_P2
