if (RasterGeom/length(geoms) > 0.5) "above" else "below" 出错：条件长度 > 1

Question

当我运行以下代码时（来源：embed image: ggplot to plotly date issue）：

library(ggplot2)
library(png)
library(RCurl)
library(plotly)
mydf <- data.frame(date = 
                   as.Date(c("01/01/1998", "10/01/1998", "15/01/1998", 
                             "25/01/1998", "01/02/1998", "12/02/1998", "20/02/1998"), "%d/%m/%Y"),
                 counts = c(12, 10, 2, 24, 15, 1, 14),
                 image = c(NA, "https://www.r-project.org/logo/Rlogo.png", NA, NA, 
                           "https://www.r-project.org/logo/Rlogo.png", NA, NA))
mydf

# You should find some way to compute your desired image height and image width
yHeight <- (max(mydf$counts) - min(mydf$counts)) * 0.05
xWidth <- (max(as.numeric(mydf$date)) - min(as.numeric(mydf$date))) * 0.05

# create the base plot
gg2 <- ggplot(mydf, aes(date, counts)) + 
  geom_line()

# for each row in the df
for (x in 1:nrow(mydf)) {
  row <- mydf[x, ]
  if(!is.na(row$image)){
    # read the image
    img <- readPNG(getURLContent(row$image))
    # add the image with annotation_raster
    gg2 <- gg2 + annotation_raster(img, 
                            xmin = as.numeric(row$date) - xWidth/2, 
                            xmax = as.numeric(row$date) + xWidth/2, 
                            ymin = row$counts - yHeight/2, 
                            ymax = row$counts + yHeight/2)
  }
}

ggplotly(gg2)

我有这个错误信息：

Error in if (RasterGeom/length(geoms) > 0.5) "above" else "below" : 
  the condition has length > 1

（我无法对答案发表评论，所以我提出了一个新问题）

非常感谢

Answer 1

我找不到解决这个问题的方法，所以我想出了一个新的解决方案来解决你原来的问题。有两种不同的方法可以解决这个问题，要么使用ggplot() 和ggplotly()，要么只使用plotly()。

这不使用包png 或RCurl。不过，它确实使用了 magick 包。

首先，我在您的数据框中将日期更改为 POSIXct，因此它们可以更好地与 Plotly 一起使用（也就是说，它们可以与 Javascript 一起使用）。我也只使用了原始图表的第一部分。

library(tidyverse)
library(plotly)
library(magick)

mydf$date <- as.POSIXct(mydf$date)

# create the base plot
gg2 <- ggplot(mydf, aes(date, counts)) + 
  geom_line()

然后我为ggplotly 对象设置图像跟踪。首先我编写了一个函数来查找日期之间的天数，然后我创建了为 Plotly 格式化的数据。

# for the x domain; difference in days + 1
dt = function(d1 = min(mydf$date), d2){
  x = length(seq(d1, d2, by = "day"))
  return(x)
}
mdf = mydf %>%        # image rows only
  filter(!is.na(mydf$image))

ig = lapply(1:nrow(mdf),
            function(i){
              # get and setup image
              img = image_read(mdf[i,]$image) %>% as.raster()
              # get domain splitter for the x-axis (whole weeks)
              ds = ceiling(dt(d2 = max(mydf$date))/7) * 7
              # get position of current date on the x-axis
              cs = dt(d2 = mdf[i, ]$date) + 2
              list(source = raster2uri(img),
                   xref = "paper", yref = "y",
                   xanchor = "center", yanchor = "middle",
                   x = 1/ds * cs,
                   y = mdf[i, ]$counts,
                   sizex = 1.5, sizey = 1.5)
            })

您现在可以将此列表列表添加到ggplotly 对象。

ggplotly(gg2) %>% 
  layout(images = ig)

或者，您可以直接使用 Plotly。

plot_ly(data = mydf, x = ~date, y = ~counts, 
        mode = "lines+markers", type = "scatter") %>% 
  layout(images = ig)

或者，如果您不想要 Plotly 中的标记（连同线条）...

ig2 = lapply(1:nrow(mdf),
            function(i){
              # get and setup image
              img = image_read(mdf[i,]$image) %>% as.raster()
              # get domain splitter
              ds = dt(d2 = max(mydf$date)) - 1 # exact fit
              # get position of current date on the x-axis
              cs = dt(d2 = mdf[i, ]$date) - 1  # exact fit
              list(source = raster2uri(img),
                   xref = "paper", yref = "y",
                   xanchor = "center", yanchor = "middle",
                   x = 1/ds * cs,
                   y = mdf[i, ]$counts,
                   sizex = 1.5, sizey = 1.5)
            })
plot_ly(data = mydf, x = ~date, y = ~counts, 
        mode = "lines", type = "scatter") %>% 
  layout(images = ig2)