Chapter 12 其他-ggplotExamples

  • 利用ggplot2包绘制的3个较有代表性的图形
library("ggplot2")
library("ggpubr")  

rm(list = ls())
V5_value <- function(mz) {
  if ((mz[1, 3] > 0) & (mz[1, 4] > 0)) {
    "优势区"
  } else if ((mz[1, 3] > 0) & (mz[1, 4] < 0)) {
    "锦上添花区"
  } else if ((mz[1, 3] <= 0) & (mz[1, 4] <= 0)) {
    "次要改进区"
  } else {"亟待改进区"}
}
mz <- read.table("mz.csv", header = T, sep = ",")
mz
##    V1       V2     V3    V4
## 1   * 61.07621 -19.91 -2.75
## 2   * 83.23221   2.25 -3.80
## 3   * 85.84785   4.86 -3.95
## 4   * 86.00211   5.02 -3.88
## 5   * 81.00169   0.02 -3.50
## 6   * 85.46017   4.47 -3.80
## 7   * 85.46219   4.48 -0.95
## 8   * 86.58748   5.60 -1.03
## 9   * 76.60645  -4.38  2.80
## 10  * 82.92574   1.94  1.30
## 11  * 78.42845  -2.56  2.57
## 12  * 85.00176   4.02  1.45
## 13  * 83.35798   2.37  1.07
## 14  * 61.51060 -19.48  2.50
## 15  * 88.87589   7.89  4.07
## 16  * 87.54664   6.56  5.20
## 17  * 62.64494 -18.34  9.70
## 18  * 83.81991   2.83  7.37
## 19  * 87.41066   6.42 -1.70
## 20  * 84.67033   3.68 -1.25
## 21  * 86.18587   5.20 -1.63
## 22  * 84.52692   3.54 -2.00
## 23  * 84.97464   3.99 -1.70
## 24  * 87.06166   6.08 -2.45
## 25  * 87.57276   6.59 -2.90
## 26  * 70.92593 -10.06 -0.65
## 27  * 67.90689 -13.08 -0.05
mz <- purrrlyr::by_row(mz, V5_value, .collate = "cols")

mznames <- c("停车感受",
             "环境整洁秩序",
             "门诊便利设备",
             "门诊指引标识",
             "卫生间使用",
             "隐私保护",
             "就医流程",
             "导医服务",
             "挂号等候时间",
             "缴费等候时间",
             "取药等候时间",
             "乘电梯等候时间",
             "候诊等候时间",
             "医生看病时间",
             "尊重与关心",
             "询问病情",
             "病情解释",
             "护理技术",
             "医生倾听诉求",
             "护士倾听诉求",
             "及时响应",
             "医技检查人员态度",
             "挂号收费人员态度",
             "药房人员态度",
             "保安人员态度",
             "就医花费",
             "就医时间")
mz$V1 <- mznames
mz
## # tibble [27 x 5]
##    V1              V2       V3     V4 .out      
##    <chr>        <dbl>    <dbl>  <dbl> <chr>     
##  1 停车感受      61.1 -19.9    -2.75  次要改进区
##  2 环境整洁秩序  83.2   2.25   -3.80  锦上添花区
##  3 门诊便利设备  85.8   4.86   -3.95  锦上添花区
##  4 门诊指引标识  86.0   5.02   -3.88  锦上添花区
##  5 卫生间使用    81.0   0.0200 -3.50  锦上添花区
##  6 隐私保护      85.5   4.47   -3.80  锦上添花区
##  7 就医流程      85.5   4.48   -0.950 锦上添花区
##  8 导医服务      86.6   5.60   -1.03  锦上添花区
##  9 挂号等候时间  76.6 - 4.38    2.80  亟待改进区
## 10 缴费等候时间  82.9   1.94    1.30  优势区    
## # ... with 17 more rows
ggtext(mz, x = "V3", y = "V4", 
       color = ".out", label = "V1",
       repel = TRUE, size = 9, label.rectangle = TRUE) + 
  geom_hline(yintercept = 0, color = "grey50", size = 1.0) +
  geom_vline(xintercept = 0, color = "grey50", size = 1.0) +
  geom_point(aes(colour = .out, shape = .out), size = 1.8) +
  scale_colour_discrete(l = 40) +
  xlim(-20,20) + 
  ylim(-10,10) + 
  xlab(label = NULL) + 
  ylab(label = NULL) +
  annotate("text",
           x = c(20,18.5,-4,-4), y = c(10,-10,-10,10),
           label = c("优势区","锦上添花区","次要改进区","亟待改进区"),
           colour = "black", fontface = "bold") +
  theme(axis.text = element_blank(),
        axis.ticks = element_blank(),
        legend.title = element_blank(),
        legend.position = "none",
        panel.grid = element_blank(),
        panel.background = element_rect(fill = "white"),
        plot.margin = margin(0.5,0.5,0.5,0.5,"cm"),
        plot.background = element_rect(colour = "black", size = 4))

zy <- read.table("zy.csv", header = T, sep = ",")
zy <- purrrlyr::by_row(zy, V5_value, .collate = "cols") 

c("等候床位时间",
  "入院手续办理时间",
  "入院指引",
  "入院宣教",
  "查房服务",
  "医生倾听诉求",
  "解释治疗方案",
  "用药事项告知",
  "检查说明",
  "护士倾听诉求",
  "护士技术水平",
  "响应速度",
  "病区环境清洁",
  "病区通风",
  "病房设施设备",
  "卫生间清洁",
  "隐私保护",
  "晾晒衣物",
  "探视管理",
  "出院手续办理",
  "出院事项告知",
  "电话回访"
) -> zynames

zy$V1 <- zynames
zy
## # tibble [22 x 5]
##    V1                  V2     V3     V4 .out      
##    <chr>            <dbl>  <dbl>  <dbl> <chr>     
##  1 等候床位时间      84.8 -3.58   2.90  亟待改进区
##  2 入院手续办理时间  85.6 -2.75   1.78  亟待改进区
##  3 入院指引          89.6  1.23  -0.940 锦上添花区
##  4 入院宣教          91.2  2.81  -1.34  锦上添花区
##  5 查房服务          83.6 -4.74   2.26  亟待改进区
##  6 医生倾听诉求      90.6  2.25   1.54  优势区    
##  7 解释治疗方案      89.9  1.55   1.94  优势区    
##  8 用药事项告知      89.5  1.14   2.18  优势区    
##  9 检查说明          88.8  0.400  2.74  优势区    
## 10 护士倾听诉求      91.0  2.59   1.30  优势区    
## # ... with 12 more rows
ggtext(zy, x = "V3", y = "V4", 
       color = ".out", label = "V1",
       repel = TRUE, size = 9, label.rectangle = TRUE) + 
  geom_hline(yintercept = 0, color = "grey50", size = 1.0) +
  geom_vline(xintercept = 0, color = "grey50", size = 1.0) +
  geom_point(aes(colour = .out, shape = .out), size = 1.8) +
  scale_colour_discrete(l = 40) +
  xlim(-10,10) + 
  ylim(-6,6) + 
  xlab(label = NULL) + 
  ylab(label = NULL) +
  annotate("text",
           x = c(10,9,-9,-9), y = c(6,-6,-6,6),
           label = c("优势区","锦上添花区","次要改进区","亟待改进区"),
           colour = "black", fontface = "bold") +
  theme(axis.text = element_blank(),
        axis.ticks = element_blank(),
        legend.title = element_blank(),
        legend.position = "none",
        panel.grid = element_blank(),
        panel.background = element_rect(fill = "white"),
        plot.margin = margin(0.5,0.5,0.5,0.5,"cm"),
        plot.background = element_rect(colour = "black", size = 4))

figuredata <- tibble::tribble(
   ~YearMonth,        ~Type, ~TS,
    "2009Nov",   "Influent",  6,
    "2009Nov",       "STW1", 16,
    "2009Nov",       "STW2", 17,
    "2009Nov",       "STW3", 15,
    "2010Mar",   "Influent",  5,
    "2010Mar",     "STW1", 13,
    "2010Mar",     "STW2", 15,
    "2010Mar",     "STW3", 14,
    "2010Jul", "Influent",  5,
    "2010Jul",     "STW1", 45,
    "2010Jul",     "STW2", 46,
    "2010Jul",     "STW3", 48,
    "2010Nov", "Influent",  5,
    "2010Nov",     "STW1", 18,
    "2010Nov",     "STW2", 19,
    "2010Nov",     "STW3", 17,
    "2011Mar", "Influent",  5,
    "2011Mar",     "STW1", 18,
    "2011Mar",     "STW2", 19,
    "2011Mar",     "STW3", 17,
    "2011Apr", "Influent", NA,
    "2011Apr",     "STW1", 19,
    "2011Apr",     "STW2", 19,
    "2011Apr",     "STW3", 18,
    "2011May", "Influent", NA,
    "2011May",     "STW1", 21,
    "2011May",     "STW2", 20,
    "2011May",     "STW3", 19,
    "2011June", "Influent", NA,
    "2011June",     "STW1", 21,
    "2011June",     "STW2", 21,
    "2011June",     "STW3", 21
) 
   

levels(figuredata$YearMonth) <- 
  figuredata$YearMonth[seq(1, 32, by = 4)]

ggplot(figuredata, aes(x = YearMonth, y = TS)) + 
  geom_col(aes(color = Type, fill = Type), 
           width = 0.1,
           position = position_dodge(width = 0.6)) + 
  geom_point(aes(color = Type, shape = Type),
             position = position_dodge(width = 0.6)) +
  scale_y_continuous(limits = c(0,100), 
                     breaks = seq(0,100,by = 20)) +
  geom_vline(xintercept = 5.5) + 
  annotate("text", x = c(3, 7), y = c(90, 90), 
           label = c("Feedind period", "Resting period")) +
  geom_hline(yintercept = seq(0,100,by = 20), linetype = 2) +     
  theme(panel.background = element_rect(fill = "white", 
                                        colour = "black"),
        legend.background = element_blank(),
        legend.position = c(0.1,0.8),
        legend.title = element_blank(),
        legend.box.background = element_rect(fill = "white", 
                                             colour = "black"),
        legend.key = element_rect(colour = "black"),
        legend.key.width = unit(0.5, units = "cm"),
        legend.key.height = unit(0.5, units = "cm"),
        axis.text.x = element_text(
          colour = c("darkred", 
                     rep("darkcyan", 3), 
                     rep("darkblue", 4)))) +
  labs(x = NULL, y = "TS(%)") +
  scale_color_brewer(palette = "Spectral", type = "seq") +
  scale_fill_brewer(palette = "Spectral", type = "seq")
## Warning: Removed 3 rows containing missing values (geom_col).
## Warning: Removed 3 rows containing missing values (geom_point).

fig_data <- read.csv("data-dot-plot.csv", header = TRUE)
fig_data
##   Group1 Group2 Group3 Group4
## 1  12.27  22.17  35.15  22.58
## 2  23.11  26.54  42.19  34.71
## 3  17.89  33.12  36.10  25.16
## 4  26.51  27.97  39.57  18.19
## 5  27.19  19.16  42.66  23.14
## 6  34.11  29.11  31.01  33.80
## 7  29.70  27.36  50.20  26.69
## 8  17.66  21.22  44.79  19.87
means <- data.frame(means = colMeans(fig_data))
means$group_names <- rownames(means)
means
##           means group_names
## Group1 23.55500      Group1
## Group2 25.83125      Group2
## Group3 40.20875      Group3
## Group4 25.51750      Group4
library(tidyr)
## Warning: package 'tidyr' was built under R version 3.4.4
## 
## Attaching package: 'tidyr'
## The following object is masked from 'package:magrittr':
## 
##     extract
library(dplyr)

color2 <- c("#EE7600", "#3300cc", "#8B8378", "#4B0082") # dark
color1 <- c("#EEE685", "#3366cc", "#C4C4C4", "#8470FF")

figdata <- fig_data %>% 
  mutate(unique = row_number()) %>% 
  gather(variables, values, -unique) %>% 
  mutate(groupToNum = case_when(variables == "Group1" ~ 1,
                                variables == "Group2" ~ 2,
                                variables == "Group3" ~ 3,
                                variables == "Group4" ~ 4)) %>% 
  mutate(add_random = groupToNum + 
           rnorm(nrow(fig_data) * ncol(fig_data), 
                 mean = 0, sd = 0.05)) %>% 
  mutate(colors = case_when(variables == "Group1" ~ color2[1],
                            variables == "Group2" ~ color2[2],
                            variables == "Group3" ~ color2[3],
                            variables == "Group4" ~ color2[4]))

colors <- figdata$colors
figdata
##    unique variables values groupToNum add_random  colors
## 1       1    Group1  12.27          1  0.8845416 #EE7600
## 2       2    Group1  23.11          1  1.0502869 #EE7600
## 3       3    Group1  17.89          1  0.9645400 #EE7600
## 4       4    Group1  26.51          1  0.9655996 #EE7600
## 5       5    Group1  27.19          1  1.0512786 #EE7600
## 6       6    Group1  34.11          1  0.9857613 #EE7600
## 7       7    Group1  29.70          1  0.9389641 #EE7600
## 8       8    Group1  17.66          1  1.0090652 #EE7600
## 9       1    Group2  22.17          2  1.9930554 #3300cc
## 10      2    Group2  26.54          2  2.0002882 #3300cc
## 11      3    Group2  33.12          2  2.0192640 #3300cc
## 12      4    Group2  27.97          2  1.9814670 #3300cc
## 13      5    Group2  19.16          2  2.0322188 #3300cc
## 14      6    Group2  29.11          2  1.9889757 #3300cc
## 15      7    Group2  27.36          2  2.0165891 #3300cc
## 16      8    Group2  21.22          2  2.0548420 #3300cc
## 17      1    Group3  35.15          3  3.0217591 #8B8378
## 18      2    Group3  42.19          3  2.9837034 #8B8378
## 19      3    Group3  36.10          3  3.0574404 #8B8378
## 20      4    Group3  39.57          3  3.0496752 #8B8378
## 21      5    Group3  42.66          3  3.0274198 #8B8378
## 22      6    Group3  31.01          3  3.0119366 #8B8378
## 23      7    Group3  50.20          3  2.9686047 #8B8378
## 24      8    Group3  44.79          3  3.0680326 #8B8378
## 25      1    Group4  22.58          4  3.9699870 #4B0082
## 26      2    Group4  34.71          4  4.1093666 #4B0082
## 27      3    Group4  25.16          4  4.0766305 #4B0082
## 28      4    Group4  18.19          4  3.9882150 #4B0082
## 29      5    Group4  23.14          4  3.9486790 #4B0082
## 30      6    Group4  33.80          4  3.9644797 #4B0082
## 31      7    Group4  26.69          4  4.0128442 #4B0082
## 32      8    Group4  19.87          4  3.9876654 #4B0082
group2_3 <- data.frame(x = c(2.40,2.50,2.60), 
                       y = c(62, 62, 62))
group1_3 <- data.frame(x = c(1.90,2.00,2.10),
                       y = c(68, 68, 68))
group3_4 <- data.frame(x = c(3.40,3.50,3.60),
                       y = c(74, 74, 74))

theme_set(theme_classic())
ggplot() +
  geom_segment(data = means, aes(x = group_names,
                                 y = means,
                                 xend = group_names,
                                 yend = 0),
               size = 25, color = color1) +
  geom_point(data = figdata, aes(x = add_random,
                                 y = values,
                                 color = variables),
             size = 5, alpha = 0.7) +
  geom_point(data = figdata, aes(x = add_random,
                                 y = values),
             shape = 21, size = 5, stroke = 1) +
  scale_color_manual(values = c("Group1" = color2[1],
                                "Group2" = color2[2],
                                "Group3" = color2[3],
                                "Group4" = color2[4])) +
  scale_y_continuous(breaks = seq(0, 80, 20), 
                     limits = c(0, 80), expand = c(0, 0)) +
  geom_segment(aes(x = 2, y = 60, xend = 3, yend = 60), size = 1.3) +
  geom_point(data = group2_3, aes(x = x, y = y), shape = 8) +
  geom_segment(aes(x = 1, y = 66, xend = 3, yend = 66), size = 1.3) +
  geom_point(data = group1_3, aes(x = x, y = y), shape = 8) +
  geom_segment(aes(x = 3, y = 72, xend = 4, yend = 72), size = 1.3) +
  geom_point(data = group3_4, aes(x = x, y = y), shape = 8) +
  theme(panel.grid = element_blank(), 
        legend.position = "top",
        axis.text.x = element_blank(),
        axis.ticks.x = element_blank(),
        axis.title.x = element_blank()) +
  labs(y = "name_of_y_axis",
       color = "Groups")

###
ggplot() +
  geom_segment(data = means, aes(x = group_names,
                                 y = means,
                                 xend = group_names,
                                 yend = 0),
               size = 25, color = color1) +
  geom_point(data = figdata, aes(x = add_random,
                                 y = values,
                                 shape = variables,
                                 fill = variables),
             size = 5, alpha = 0.7) +
  scale_shape_manual(values = c("Group1" = 21,
                                "Group2" = 22,
                                "Group3" = 23,
                                "Group4" = 24)) +
  scale_fill_manual(values = c("Group1" = color2[1],
                               "Group2" = color2[2],
                               "Group3" = color2[3],
                               "Group4" = color2[4])) +
  scale_y_continuous(breaks = seq(0, 80, 20), 
                     limits = c(0, 80), expand = c(0, 0)) +
  geom_segment(aes(x = 2, y = 60, xend = 3, yend = 60), size = 1.1) +
  geom_point(data = group2_3, aes(x = x, y = y), shape = 8) +
  geom_segment(aes(x = 1, y = 66, xend = 3, yend = 66), size = 1.1) +
  geom_point(data = group1_3, aes(x = x, y = y), shape = 8) +
  geom_segment(aes(x = 3, y = 72, xend = 4, yend = 72), size = 1.1) +
  geom_point(data = group3_4, aes(x = x, y = y), shape = 8) +
  theme(panel.grid = element_blank(), 
        legend.position = "top",
        axis.text.x = element_blank(),
        axis.ticks.x = element_blank(),
        axis.title.x = element_blank()) +
  labs(y = "name_of_y_axis") +
  guides(shape = guide_legend("Groups"),
         fill = guide_legend("Groups"))

###
fig_data <- read.csv("data-dot-plot.csv", header = TRUE)
fig_data
##   Group1 Group2 Group3 Group4
## 1  12.27  22.17  35.15  22.58
## 2  23.11  26.54  42.19  34.71
## 3  17.89  33.12  36.10  25.16
## 4  26.51  27.97  39.57  18.19
## 5  27.19  19.16  42.66  23.14
## 6  34.11  29.11  31.01  33.80
## 7  29.70  27.36  50.20  26.69
## 8  17.66  21.22  44.79  19.87
means <- data.frame(means = colMeans(fig_data))
means$group_names <- rownames(means)
means
##           means group_names
## Group1 23.55500      Group1
## Group2 25.83125      Group2
## Group3 40.20875      Group3
## Group4 25.51750      Group4
# 配色: http://www.atool.org/colorpicker.php
color2 <- c("#EE7600", "#3300cc", "#8B8378", "#4B0082") # dark
color1 <- c("#EEE685", "#3366cc", "#C4C4C4", "#8470FF")

figdata <- fig_data %>% 
  mutate(unique = row_number()) %>% 
  gather(variables, values, -unique) %>% 
  mutate(groupToNum = case_when(variables == "Group1" ~ 1,
                                variables == "Group2" ~ 2,
                                variables == "Group3" ~ 3,
                                variables == "Group4" ~ 4)) %>% 
  mutate(add_random = groupToNum + 
           rnorm(nrow(fig_data) * ncol(fig_data), 
                 mean = 0, sd = 0.05)) %>% 
  mutate(colors = case_when(variables == "Group1" ~ color2[1],
                            variables == "Group2" ~ color2[2],
                            variables == "Group3" ~ color2[3],
                            variables == "Group4" ~ color2[4]))
colors <- figdata$colors
figdata
##    unique variables values groupToNum add_random  colors
## 1       1    Group1  12.27          1  0.9826229 #EE7600
## 2       2    Group1  23.11          1  0.9524191 #EE7600
## 3       3    Group1  17.89          1  0.9977486 #EE7600
## 4       4    Group1  26.51          1  0.9607548 #EE7600
## 5       5    Group1  27.19          1  0.9166029 #EE7600
## 6       6    Group1  34.11          1  0.9809887 #EE7600
## 7       7    Group1  29.70          1  1.0459498 #EE7600
## 8       8    Group1  17.66          1  0.9712327 #EE7600
## 9       1    Group2  22.17          2  2.0303982 #3300cc
## 10      2    Group2  26.54          2  1.9191059 #3300cc
## 11      3    Group2  33.12          2  1.9972219 #3300cc
## 12      4    Group2  27.97          2  2.0259704 #3300cc
## 13      5    Group2  19.16          2  2.0150577 #3300cc
## 14      6    Group2  29.11          2  2.0052838 #3300cc
## 15      7    Group2  27.36          2  1.9679647 #3300cc
## 16      8    Group2  21.22          2  1.9575148 #3300cc
## 17      1    Group3  35.15          3  2.9487936 #8B8378
## 18      2    Group3  42.19          3  3.0058823 #8B8378
## 19      3    Group3  36.10          3  2.9526263 #8B8378
## 20      4    Group3  39.57          3  2.9754721 #8B8378
## 21      5    Group3  42.66          3  2.9871954 #8B8378
## 22      6    Group3  31.01          3  3.0921931 #8B8378
## 23      7    Group3  50.20          3  2.9674025 #8B8378
## 24      8    Group3  44.79          3  3.0117693 #8B8378
## 25      1    Group4  22.58          4  4.0038980 #4B0082
## 26      2    Group4  34.71          4  3.9519072 #4B0082
## 27      3    Group4  25.16          4  3.9964346 #4B0082
## 28      4    Group4  18.19          4  4.0722275 #4B0082
## 29      5    Group4  23.14          4  4.0225752 #4B0082
## 30      6    Group4  33.80          4  4.0020616 #4B0082
## 31      7    Group4  26.69          4  3.9788752 #4B0082
## 32      8    Group4  19.87          4  3.8973376 #4B0082
group2_3 <- data.frame(x = c(2.45,2.50,2.55),
                       y = c(62, 62, 62))
group1_3 <- data.frame(x = c(1.95,2.00,2.05),
                       y = c(68, 68, 68))
group3_4 <- data.frame(x = c(3.45,3.50,3.55),
                       y = c(74, 74, 74))

theme_set(theme_light())
ggplot() +
  geom_segment(data = means, aes(x = group_names,
                                 y = means,
                                 xend = group_names,
                                 yend = 0),
               size = 25, color = color1) +
  geom_point(data = figdata, aes(x = add_random,
                                 y = values),
             shape = 21, color = "black", fill = colors, 
             size = 5, alpha = 0.7, stroke = 1) +
  scale_y_continuous(breaks = seq(0, 80, 20), limits = c(0, 80), expand = c(0, 0)) +
  geom_segment(aes(x = 2, y = 60, xend = 3, yend = 60), size = 1.5) +
  geom_point(data = group2_3, aes(x = x, y = y), shape = 8) +
  geom_segment(aes(x = 1, y = 66, xend = 3, yend = 66), size = 1.5) +
  geom_point(data = group1_3, aes(x = x, y = y), shape = 8) +
  geom_segment(aes(x = 3, y = 72, xend = 4, yend = 72), size = 1.5) +
  geom_point(data = group3_4, aes(x = x, y = y), shape = 8) +
  theme(panel.grid = element_blank()) +
  labs(x = "name_of_x_axis",
       y = "name_of_y_axis")