r - R中的龙卷风/双面水平条形图，图表轴在给定值处交叉（而不是在零处交叉）

Question

我想在 R 中绘制一个龙卷风图（双面水平条形图），用于确定性灵敏度分析，我已经尝试了一些代码但没有得到所需的输出。

我想实现：-

1. 该图应按敏感参数的降序排列（即最宽的区间应显示在图表的顶部 - 为了获得敏感度，我们首先计算下限值和上限值的绝对差，我将其命名为“UL_Difference”我的数据框代码）。

2. 中心不应为零，而应为给定值，称为“基本情况”或我的结果表的核心/最终结果（我们希望使用下限和上限检查不同固定参数的影响参数值并生成下界和上界值的核心结果）。Excel VBA 中的示例代码是

3. 该图应具有标题“药物 A 与 P 的龙卷风图”。

我尝试了很多代码。下面是一个例子，它给了我一个龙卷风图，但不完全是我想从 R 生成的。

Base_Result <- results.table[5,4] # Base/Core result (which I have not used in my codes below yet)

Drug_AP <- seq(1, 48, 4)
D_AP <- data.frame(OWSA[Drug_AP,]) # OWSA[] is a 10x3 matrix with 'Lower_Bound', 'Upper_Bound' and Absolute Difference of the LB and UB termed as 'UL_Difference' (row names are parameters)
DSA_Drug_AP <- D_AP[order(D_AP$UL_Difference, decreasing = T),] # Ordering the data.frame above in Descending order of 'UL_Difference'
cat("DSA Table: Drug A vs P \n")
library(formattable)
print(accounting(as.matrix(DSA_Drug_AP), digits = 0, format = "f", big.mark = ","), right = T) # Just printing the above data.frame

我尝试了以下代码来绘制龙卷风：-

（我不确定是否应该制作以下数据框，也许这是我没有得到所需输出的原因之一）

dat <- data.frame(Group = c(rep("Lower_Bound", 12), rep("Upper_Bound", 12)), 
                  Parameters = rep(rownames(DSA_Drug_AP), 2), 
                  UL = c(-DSA_Drug_AP[,1], DSA_Drug_AP[,2]))

（最后我用“ggplot”绘制了上面的数据框，如下图）

library(ggplot2)
ggplot(dat, aes(x = Parameters, y = UL, fill = Group)) + 
    coord_flip() + 
    geom_bar(stat = "identity", position = "identity", width = 0.525) +
    theme(legend.position="top", axis.text.x = element_text(angle = 0, hjust = 0.5, vjust = 0.5, size = 10))

并获得如下输出： -

下面是我想要实现的输出（点 #1 和 #2 已实现；图表是从 excel 生成的）。

# Also, the data I'm using is shown below: -

Base_Result <- 9,504  # Value of results.table[5,4] on which I get 'lower' and 'upper' limit values below (and want tornado with the origin at this base_result).

# My data.frame "D_AP" will look like (I just renamed my parameters to 1(to)12)

           Lower_Bound  Upper_Bound UL_Difference
Parameter_01     8,074      11,181   3,108 
Parameter_02     8,177      11,007   2,831 
Parameter_03     8,879      10,188   1,308 
Parameter_04     4,358      18,697   14,339 
Parameter_05     9,073      10,087   1,013 
Parameter_06     12,034      7,572   4,462 
Parameter_07     11,357      7,933   3,423 
Parameter_08     9,769       9,202   567 
Parameter_09     8,833      10,403   1,570 
Parameter_10     13,450      4,219   9,231 
Parameter_11     10,691      7,915   2,776 
Parameter_12     10,036      8,792   1,244 

# Once, I did sort in descending order then it will be data.frame "DSA_Drug_AP" as below: -

            Lower_Bound Upper_Bound UL_Difference
Parameter_04     4,358      18,697   14,339 
Parameter_10     13,450      4,219   9,231 
Parameter_06     12,034      7,572   4,462 
Parameter_07     11,357      7,933   3,423 
Parameter_01     8,074      11,181   3,108 
Parameter_02     8,177      11,007   2,831 
Parameter_11     10,691      7,915   2,776 
Parameter_09     8,833      10,403   1,570 
Parameter_03     8,879      10,188   1,308 
Parameter_12     10,036      8,792   1,244 
Parameter_05     9,073      10,087   1,013 
Parameter_08     9,769       9,202   567 

# Please note that I need to plot the 1st and 2nd column of values 
# (shown in above table in order of 3rd column as a tornado plot).
# The parameter-## names will come to the left vertical line of plot.

先感谢您！

标签： rggplot2bar-chart

Answer 1

我前段时间尝试过这样做geom_bar()，但并不好玩。geom_bar()默认情况下堆叠以零为参考的列。我必须在列中创建空白部分以获得（某种）我想要的效果。

更好的方法是使用geom_rect(). 您只需要稍微调整一下您的数据框即可获得所需的xmin美学效果（与尝试解决问题相比，工作量要少xmax得多）yminymaxgeom_bar()

由于您没有发布数据集，因此我创建了一个非常简单的数据集。但希望结构与您的结构足够接近

---

编辑：我更改了代码以在您的示例中包含数据框。

library(ggplot2)
library(plyr)
library(dplyr)
library(tidyverse)

# this is throwing some warnings in my computer, but it is reading the data frame correctly
df <- '
Parameter Lower_Bound Upper_Bound UL_Difference
Parameter01 8074 11181 3108 
Parameter02 8177 11007 2831 
Parameter03 8879 10188 1308 
Parameter04 4358 18697 14339 
Parameter05 9073 10087 1013 
Parameter06 12034 7572 4462 
Parameter07 11357 7933 3423 
Parameter08 9769 9202 567 
Parameter09 8833 10403 1570 
Parameter10 13450 4219 9231 
Parameter11 10691 7915 2776 
Parameter12 10036 8792 1244
' %>% read_table2()

# original value of output
base.value <- 9504

# get order of parameters according to size of intervals
# (I use this to define the ordering of the factors which I then use to define the positions in the plot)
order.parameters <- df %>% arrange(UL_Difference) %>%
  mutate(Parameter=factor(x=Parameter, levels=Parameter)) %>%
  select(Parameter) %>% unlist() %>% levels()

# width of columns in plot (value between 0 and 1)
width <- 0.95

# get data frame in shape for ggplot and geom_rect
df.2 <- df %>% 
  # gather columns Lower_Bound and Upper_Bound into a single column using gather
  gather(key='type', value='output.value', Lower_Bound:Upper_Bound) %>%
  # just reordering columns
  select(Parameter, type, output.value, UL_Difference) %>%
  # create the columns for geom_rect
  mutate(Parameter=factor(Parameter, levels=order.parameters),
         ymin=pmin(output.value, base.value),
         ymax=pmax(output.value, base.value),
         xmin=as.numeric(Parameter)-width/2,
         xmax=as.numeric(Parameter)+width/2)

# create plot
# (use scale_x_continuous to change labels in y axis to name of parameters)
png(width = 960, height = 540)
ggplot() + 
  geom_rect(data = df.2, 
            aes(ymax=ymax, ymin=ymin, xmax=xmax, xmin=xmin, fill=type)) +
  theme_bw() + 
  theme(axis.title.y=element_blank(), legend.position = 'bottom',
        legend.title = element_blank()) + 
  geom_hline(yintercept = base.value) +
  scale_x_continuous(breaks = c(1:length(order.parameters)), 
                     labels = order.parameters) +
  coord_flip()
dev.off()