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

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())

创建于 2021-04-30 由 reprex package (v0.3.0)

Answer 1

这是剪辑的问题。问题还在于绘图设备的白色标准背景。下面是一个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
}