将 ggplot object 转换为 plotly object 创建与刻度值重叠的轴标题

Question

我遇到了这个问题中描述的相同问题：

但是当我实施解决方案时，出现以下错误：

Warning: Ignoring unknown aesthetics: text We recommend that you use the dev version of ggplot2 with ggplotly() Install it with: devtools::install_github('hadley/ggplot2') Error in tmp[[2]] : subscript out of bounds

此代码将在我的机器上产生此错误：

library(gapminder)
library(plotly)
library(ggplot2)

lead <- rep("Fred Smith", 30)
lead <- append(lead, rep("Terry Jones", 30))
lead <- append(lead, rep("Henry Sarduci", 30))
proj_date <- seq(as.Date('2017-11-01'), as.Date('2017-11-30'), by = 'day')
proj_date <- append(proj_date, rep(proj_date, 2))
set.seed(1237)
actHrs <- runif(90, 1, 100)
cummActHrs <- cumsum(actHrs)
forHrs <- runif(90, 1, 100)
cummForHrs <- cumsum(forHrs)
df <- data.frame(Lead = lead, date_seq = proj_date,
                 cActHrs = cummActHrs,
                 cForHrs = cummForHrs)

makePlot <- function(dat=df, man_level = 'Lead') {
    p <- ggplot(dat, aes_string(x='date_seq', y='cActHrs',
                               group = man_level,
                               color = man_level),
                linetype = 1) +
         geom_line() +
         geom_line(data=df,
                   aes_string(x='date_seq', y = 'cForHrs',
                              group = man_level,
                              color = man_level),
                   linetype = 2)

    p <- p + geom_point(aes(text=sprintf('%s\nManager: %s\n MTD Actual Hrs: %s\nMTD Forecasted Hrs: %s',
                                         date_seq, Lead, round(cActHrs, 2), round(cForHrs, 2))))

    p <- p + theme_classic() + ylab('Hours') + xlab('Date')

    gp <- ggplotly(p, tooltip = "text") %>% layout(hovermode = "compare")
    ### FIX IMPLEMENTED HERE ###
    gp[['x']][['layout']][['annotations']][[2]][['x']] <- -0.1
    gp %>% layout(margin = list(l = 75))

    return(gp)
}

## run the example
p1 <- makePlot()

Answer 1

试试这个：

makePlot <- function(dat=df, man_level = "Lead") {
  dat$var <- dat[,man_level]
  dat$grp <- ""
  p <- ggplot(dat, aes(x=date_seq, y=cActHrs,
              group = var, color = var,
              text=paste0("Manager:", date_seq,"<br>MTD Actual Hrs:", round(cActHrs, 2),
                          "<br>MTD Forecasted Hrs:", round(cForHrs, 2))),
              linetype = 1) +
       geom_line() +
       geom_line(data=dat,
                 aes(x=date_seq, y = cForHrs,
                     group = var, color = var),
                 linetype = 2) +
        geom_point() +
        theme_classic() + ylab("Hours") + xlab("Date") +
        scale_color_discrete(name=man_level) +
        facet_wrap(~grp)

    gp <- ggplotly(p, tooltip = "text") 
    # Set y-axis label position
    gp[["x"]][["layout"]][["annotations"]][[2]][["x"]] <- -0.06
    # Set legend label position    
    gp[["x"]][["layout"]][["annotations"]][[3]][["y"]] <- 0.93
    gp <- gp %>% layout(margin = list(l = 120, b=70), hovermode = "compare")

    return(gp)
}

Answer 2

你的问题与链接的问题相反。您的轴标题是真正的轴标题，而不是注释。目前没有在任何方向移动轴标题的解决方案（参见 https://github.com/lleslie84/plotly.js/pull/1）。

向轴标题添加换行符或向刻度标签添加空格等变通方法不适用于您的情况。

一种可能的解决方法是添加带有轴标题的注释。然后可以自由移动注释。

gp <- layout(gp, yaxis = list(title = ""),
             margin = list(l = 100), 
             annotations = c(list(text = "Hours",
                                  x = -0.15,
                                  xref = "paper",
                                  showarrow = F,
                                  textangle = -90))
  )

完整代码

library(gapminder)
library(plotly)
library(ggplot2)

lead <- rep("Fred Smith", 30)
lead <- append(lead, rep("Terry Jones", 30))
lead <- append(lead, rep("Henry Sarduci", 30))
proj_date <- seq(as.Date('2017-11-01'), as.Date('2017-11-30'), by = 'day')
proj_date <- append(proj_date, rep(proj_date, 2))
set.seed(1237)
actHrs <- runif(90, 1, 100)
cummActHrs <- cumsum(actHrs)
forHrs <- runif(90, 1, 100)
cummForHrs <- cumsum(forHrs)
df <- data.frame(Lead = lead, date_seq = proj_date,
                 cActHrs = cummActHrs,
                 cForHrs = cummForHrs)

makePlot <- function(dat=df, man_level = 'Lead') {
  p <- ggplot(dat, aes_string(x='date_seq', y='cActHrs',
                              group = man_level,
                              color = man_level),
              linetype = 1) +
    geom_line() +
    geom_line(data=df,
              aes_string(x='date_seq', y = 'cForHrs',
                         group = man_level,
                         color = man_level),
              linetype = 2)

  p <- p + geom_point(aes(text=sprintf('%s\nManager: %s\n MTD Actual Hrs: %s\nMTD Forecasted Hrs: %s',
                                       date_seq, Lead, round(cActHrs, 2), round(cForHrs, 2))))

  p <- p + theme_classic() + ylab('Hours') + xlab('Date')

  gp <- ggplotly(p, tooltip = "text") %>% layout(hovermode = "compare")

  ### FIX IMPLEMENTED HERE ###
  gp <- layout(gp,
               yaxis = list(title = ""),
               margin = list(l = 100),
               annotations = c(list(text = "Hours",
                                    x = -0.15,
                                    xref = "paper",
                                    showarrow = F,
                                    textangle = -90))
  )

  return(gp)
}

## run the example
p1 <- makePlot()
p1

将 ggplot object 转换为 plotly object 创建与刻度值重叠的轴标题

Converting ggplot object to plotly object creates axis title that overlaps tick values

r

ggplot2

plotly

ggplotly