Question

我想用 ggirahExtra::ggRadar 创建一个雷达图。问题是我有很长的标签并且它们被剪掉了。我以为我可以通过在 margin = margin(0,0,2,0, "cm") 中将 element_text 添加到 axis.text 来在标签和绘图之间创建更多空间，但它不起作用。

欢迎任何增加标签空间的想法（除了缩小字体）。

添加：正如@tjebo 在评论中所建议的那样，更改 ggRadar 中的底层函数尤其是 coord_radar 可能更容易，或者可能是使其工作的唯一方法。欢迎任何有关如何执行此操作的建议。

library(ggplot2)
library(ggiraphExtra)

dat <- data.frame("Item_A_Long" = 2,
                  "Item_B_Very_Very_Long"= 0,
                  "Label_Item_C" = 1,
                  "Item_D_Label" = 4,
                  "Another_very_long_label" = 3)

ggRadar(dat,
        aes(
          x = c(Item_A_Long,
                Item_B_Very_Very_Long,
                Label_Item_C,
                Item_D_Label,
                Another_very_long_label)
        ),
        legend.position = "top",
        colour = "white",
        rescale = FALSE,
        use.label = FALSE
) +
  scale_y_continuous(expand = c(0,0),
                     limits = c(0,4)
  ) +
  theme(panel.background = element_rect(fill = "#001957"),
        # adding margin = margin(0,0,2,0, "cm") to element_text below does not help
        axis.text = element_text(color = "#FFFFFF"),
        panel.grid.major.y = element_blank())

^{由 reprex package (v0.3.0) 于 2021 年 4 月 30 日创建}

Answer 1

您可以使用 labelled 包创建带有换行符的标签，然后在 label = TRUE 中设置 ggRadar()。您可以为超长标签添加多个中断。

library(ggplot2)
library(ggiraphExtra)
library(labelled)

dat <- data.frame("Item_A_Long" = 2,
                  "Item_B_Very_Very_Long"= 0,
                  "Label_Item_C" = 1,
                  "Item_D_Label" = 4,
                  "Another_very_long_label" = 3)
var_label(dat$Item_A_Long ) <- "Item \nA long"
var_label(dat$Item_B_Very_Very_Long ) <- "Item_B_\nVery_\nVery_Long"
var_label(dat$Label_Item_C ) <- "Label_\nItem_C "
var_label(dat$Item_D_Label ) <- "Item_\nD_Label"
var_label(dat$Another_very_long_label ) <- "Another_very_\nlong_label"


ggRadar(dat,
        aes(
          x = c(Item_A_Long,
                Item_B_Very_Very_Long,
                Label_Item_C,
                Item_D_Label,
                Another_very_long_label)
        ),
        legend.position = "top",
        colour = "white",
        rescale = FALSE,
        use.label = TRUE
) +
  scale_y_continuous(expand = c(0,0),
                     limits = c(0,4)
  ) +
  theme(panel.background = element_rect(fill = "#001957"),
        # adding margin = margin(0,0,2,0, "cm") to element_text below does not help
        axis.text = element_text(color = "#FFFFFF"),
        panel.grid.major.y = element_blank())

Answer 2

这是一个剪辑的问题。问题还在于绘图设备的白色标准背景。下面是一个hacky的解决方法。

使用修改后的 ggiraphExtra::coord_radar 和 ggiraphExtra::ggRadar 关闭剪辑。请注意，我已从原始 ggRadar 函数中删除了（非常）几位，因此如果您需要所有参数，则需要自己修改该函数。
将所有背景元素变成蓝色
将所有内容叠加到纯蓝色背景上，我使用的是牛图。

library(cowplot)
library(ggplot2)

p1 <- ggRadar2(dat,
  aes(
    x = c(
      Item_A_Long,
      Item_B_Very_Very_Long,
      Label_Item_C,
      Item_D_Label,
      Another_very_long_label
    )
  ),
  colour = "white",
  rescale = FALSE,
  clip = "off"
) +
  
  theme(
   
    plot.background = element_rect(fill = "#001957", color = "#001957"),
    panel.background = element_rect(fill = "#001957"),
    # adding margin = margin(0,0,2,0, "cm") to element_text below does not help
    axis.text = element_text(color = "#FFFFFF"),
    panel.grid.major.y = element_blank()
  )

p2 <-
  ggplot() +
  theme_void()+
  theme(panel.background = element_rect(fill = "#001957"))

ggdraw(p2) + draw_plot(p1)

修改后的功能

coord_radar2 <- function(theta = "x", start = 0, direction = 1, clip = "off") {
  theta <- match.arg(theta, c("x", "y"))
  r <- if (theta == "x") {
    "y"
  } else {
    "x"
  }
  ggproto("CoordRadar", ggplot2::CoordPolar,
    theta = theta,
    r = r, start = start, clip = clip,
    direction = sign(direction), is_linear = function(coord) TRUE
  )
}

ggRadar2 <- function(data, mapping = NULL, rescale = TRUE, legend.position = "top",
                     colour = "red", alpha = 0.3, size = 3, ylim = NULL, scales = "fixed",
                     use.label = FALSE, interactive = FALSE, clip = "off", ...) {
  data <- as.data.frame(data)
  (groupname <- setdiff(names(mapping), c("x", "y")))
  groupname
  mapping
  length(groupname)
  if (length(groupname) == 0) {
    groupvar <- NULL
  }
  else {
    groupvar <- ggiraphExtra:::getMapping(mapping, groupname)
  }
  groupvar
  facetname <- colorname <- NULL
  if ("facet" %in% names(mapping)) {
    facetname <- ggiraphExtra:::getMapping(mapping, "facet")
  }
  (colorname <- setdiff(groupvar, facetname))
  if ((length(colorname) == 0) & !is.null(facetname)) {
    colorname <- facetname
  }
  data <- ggiraphExtra:::num2factorDf(data, groupvar)
  (select <- sapply(data, is.numeric))
  if ("x" %in% names(mapping)) {
    xvars <- ggiraphExtra:::getMapping(mapping, "x")
    xvars
    if (length(xvars) < 3) {
      warning("At least three variables are required")
    }
  }
  else {
    xvars <- colnames(data)[select]
  }
  (xvars <- setdiff(xvars, groupvar))
  if (rescale) {
    data <- ggiraphExtra:::rescale_df(data, groupvar)
  }
  temp <- sjlabelled::get_label(data)
  cols <- ifelse(temp == "", colnames(data), temp)
  if (is.null(groupvar)) {
    id <- ggiraphExtra:::newColName(data)
    data[[id]] <- 1
    longdf <- reshape2::melt(data, id.vars = id, measure.vars = xvars)
  }
  else {
    cols <- setdiff(cols, groupvar)
    longdf <- reshape2::melt(data, id.vars = groupvar, measure.vars = xvars)
  }
  temp <- paste0("plyr::ddply(longdf,c(groupvar,'variable'), dplyr::summarize,mean=mean(value,na.rm=TRUE))")
  df <- eval(parse(text = temp))
  colnames(df)[length(df)] <- "value"
  df
  groupvar
  if (is.null(groupvar)) {
    id2 <- ggiraphExtra:::newColName(df)
    df[[id2]] <- "all"
    id3 <- ggiraphExtra:::newColName(df)
    df[[id3]] <- 1:nrow(df)
    df$tooltip <- paste0(df$variable, "=", round(
      df$value,
      1
    ))
    df$tooltip2 <- paste0("all")
    p <- ggplot(data = df, aes_string(
      x = "variable", y = "value",
      group = 1
    )) +
      ggiraph::geom_polygon_interactive(aes_string(tooltip = "tooltip2"),
        colour = colour, fill = colour, alpha = alpha
      ) +
      ggiraph::geom_point_interactive(aes_string(
        data_id = id3,
        tooltip = "tooltip"
      ), colour = colour, size = size)
  }
  else {
    if (!is.null(colorname)) {
      id2 <- ggiraphExtra:::newColName(df)
      df[[id2]] <- df[[colorname]]
    }
    id3 <- ggiraphExtra:::newColName(df)
    df[[id3]] <- 1:nrow(df)
    df$tooltip <- paste0(
      groupvar, "=", df[[colorname]], "<br>",
      df$variable, "=", round(df$value, 1)
    )
    df$tooltip2 <- paste0(groupvar, "=", df[[colorname]])
    p <- ggplot(data = df, aes_string(
      x = "variable", y = "value",
      colour = colorname, fill = colorname, group = colorname
    )) +
      ggiraph::geom_polygon_interactive(aes_string(tooltip = "tooltip2"),
        alpha = alpha
      ) +
      ggiraph::geom_point_interactive(aes_string(
        data_id = id3,
        tooltip = "tooltip"
      ), size = size)
  }
  p
  if (!is.null(facetname)) {
    formula1 <- as.formula(paste0("~", facetname))
    p <- p + facet_wrap(formula1, scales = scales)
  }
  p <- p + xlab("") + ylab("") + theme(legend.position = legend.position)

  p <- p + coord_radar2(clip = clip)
  if (!is.null(ylim)) {
    p <- p + expand_limits(y = ylim)
  }
  p

  p
}

增加雷达图中长轴标签的空间

2 个答案: