如何将小节更改为降序?

时间:2019-07-05 22:28:39

标签: r

我希望图形的条形按降序排列。有没有办法使它自动化?我已经看过类似的问题而没有成功。

initialmth <- structure(list( 
  A = c( 10, 4),
  B = c(28, 18),
  C = c(9, 1), 
  D = c(39, 33),
  E = c(13, 8),
  F = c(37, 27), 
  G = c(30, 51), 
  H = c(31, 41)),  


  .Names = c("Math has been my worst subject ",
             "I would consider a career that uses math ",
             "Math is hard for me",
             "I am the type of student to do well in math",
             "I cannot do a good job with math",
             "I could do advanced work in math",
             "I can get good grades in math",
             "I am good at math"
  ), 
  class = "data.frame", 
  row.names = c(NA, -2L)) #4L=number of numbers in each letter vector#

attach(initialmth)
print(initialmth)
par(mar=c(0, 17, 1, 2.1))
colors <- c("slategray3", "dodgerblue4")
byb <- barplot(as.matrix(initialmth), 
               beside = F, ylim = range(0, 15), xlim = range(0, 100),
               horiz = T, col=colors,  main="N=96", xaxt="n", border=F, las=1, width 
               = 1.45)
# labels
labs <- data.frame(x=as.vector(sapply(M, xFun)),  # apply `xFun` here 
                   y=rep(byc, each=nrow(M)),  # use `byc` here
                   labels=as.vector(apply(M, 1:2, paste0, "%")), 
                   stringsAsFactors=FALSE)
labs$labels[labs$labels %in% paste0(0:(8*100)/100, "%")] <- "" #masks labels <8

invisible(sapply(seq(nrow(labs)), function(x)  # `invisible` prevents unneeded 
  console output
  text(x=labs[x, 1:2], labels=labs[x, 3], cex=.9, font=2, col=0)))

我希望使用基数R以降序重新排列小节。

3 个答案:

答案 0 :(得分:2)

您可以像这样订购数据矩阵:

par(mar=c(0, 17, 1, 2.1))
M <- as.matrix(initialmth)
o <- order(colSums(M))

colors <- c("slategray3", "dodgerblue4")
byb <- barplot(M[,o], 
               beside = F, ylim = range(0, 15), xlim = range(0, 100),
               horiz = T, col=colors,  main="N=96", xaxt="n", border=F, las=1, width 
               = 1.45)

答案 1 :(得分:1)

stats::reorder()解决了您的特定问题。我还添加了一些代码来帮助您操纵标签。

ordered-bar-plot

library(magrittr)
library(ggplot2)
palette_group <- c("A"="lightpink", "B"="slategray3")

ds <-
  M %>%
  tibble::as_tibble() %>% 
  dplyr::mutate(
    group = c("A", "B")
  ) %>% 
  tidyr::gather(key="item", value="percentage", -group) %>% 
  dplyr::group_by(item) %>% 
  dplyr::mutate(
    proportion  = percentage / 100,
    label       = paste0(percentage, "%"),
    sum_item    = sum(proportion)
  ) %>% 
  dplyr::ungroup()

subtitle <- "N = 96"

ggplot(ds, aes(x=reorder(item, sum_item), y=proportion, label=label, fill=group)) +
  geom_bar(stat="identity", alpha=.4) +
  geom_text(stat="identity", position=position_stack()) +
  scale_y_continuous(labels= scales::percent_format(accuracy=1)) +
  scale_fill_manual(values=palette_group) +
  coord_flip(ylim=c(0, 1)) +
  theme_minimal() +
  theme(legend.position=c(1, 0), legend.justification=c(1, 0)) +
  theme(panel.grid.major.y = element_blank()) +
  labs(x="Item", y="Percentage Endorsed", fill=NULL, title="{Main Title}", subtitle=subtitle)

答案 2 :(得分:0)

像以前一样,但是对于R来说更容易破解。大部分工作在数据准备中。

bar0chart

library(magrittr)
o <- order( # break ties with group a
  colSums(M),
  colSums(M[1, , drop=F])
)

ds <-
  M %>%
  tibble::as_tibble() %>% 
  dplyr::mutate(
    group = c("A", "B")
  ) %>% 
  tidyr::gather(key="item", value="percentage", -group) %>% 
  dplyr::group_by(item) %>% 
  dplyr::mutate(
    proportion  = percentage / 100,
    label       = paste0(percentage, "%"),
    sum_item    = sum(proportion)
  ) %>% 
  dplyr::ungroup()

ds_group_offset <- 
  ds %>% 
  dplyr::filter(group == "A") %>%
  dplyr::select(
    item,
    percentage_a = percentage
  )

ds_label <-
  ds %>% 
  dplyr::left_join(ds_group_offset, by="item") %>% 
  dplyr::mutate(
    rank_item = dplyr::dense_rank(sum_item + percentage_a/100),
    offset    = dplyr::if_else(group == "A", 0, percentage_a),
    position  = percentage/2 + offset
  )

实际的图形代码变化不大。

barplot(
  M[, o], 
  beside = F, ylim = range(0, 15), xlim = range(0, 100),
  horiz = T, col=colors,  main="N=96", xaxt="n", border=F, las=1, width = 1.45
)

text(ds_label$position, ds_label$rank_item * 1.75 - .75, ds_label$label)