为 R plotly scatterplot 进行正确的可视化答案

【问题标题】：Make the right visualization for R plotly scatterplot为 R plotly scatterplot 进行正确的可视化
【发布时间】：2020-12-16 06:05:56
【问题描述】：

我有一个数据框：

x = data.frame(metrics=c("type1", "type1", "type1","type1", "type1", "type1", "orders", "orders", "orders","orders", "orders", "orders", "mean","mean","mean","mean","mean","mean"), hr=c(6,7,8,6,7,8,6,7,8,6,7,8,6,7,8,6,7,8), actual=c(14,20,34,22,24,27,56,12,34,11,15,45,56,78,89,111,123,156), time_pos=c("today", "yesterday", "today", "yesterday", "today", "yesterday"))

这是绘制散点图子图的代码：

library(plotly)

plot <- function(df) {
  .pal <- RColorBrewer::brewer.pal(3, "Set2")[c(1, 3)]
  subplotList <- list()
  for(metric in unique(df$metrics)){
    showlegend <- metric == unique(df$metrics)[1]
    subplotList[[metric]] <- df[df$metrics == metric,] %>%
      plot_ly(
        x = ~ hr,
        y = ~ actual,
        color = ~ time_pos,
        colors = .pal,
        legendgroup = ~time_pos,
        showlegend = showlegend,
        hoverinfo = "text",
        hovertemplate = paste(
          "<b>%{text}</b><br>",
          "%{xaxis.title.text}: %{x:+.1f}<br>",
          "%{yaxis.title.text}: %{y:+.1f}<br>",
          "<extra></extra>"
        ),
        type = "scatter",
        mode = "lines+markers",
        marker = list(
          size = 7,
          color = "white",
          line = list(width = 1.5)
        ),
        width = 700,
        height = 620
      ) %>% 
      add_annotations(
        text = ~metrics,
        x = 0.5,
        y = 1,
        yref = "paper",
        xref = "paper",
        xanchor = "center",
        yanchor = "bottom",
        showarrow = FALSE,
        font = list(size = 15)
      ) %>% 
      layout(autosize = T, legend = list(font = list(size = 8)))
  }
  subplot(subplotList, nrows = length(subplotList), margin = 0.05)
}

plot(x)

这是一个图表：

如您所见，例如在第一个子图中，第一个标记连接到第二个和第三个标记，尽管它必须只连接到第二个标记。第二个子图也会发生同样的事情。我该如何解决？

【问题讨论】：

标签： r graph plotly r-plotly

【解决方案1】：

这可以通过相应地对 data.frame 进行排序来实现：

library(plotly)

x = data.frame(metrics=c("type1", "type1", "type1","type1", "type1", "type1", "orders", "orders", "orders","orders", "orders", "orders", "mean","mean","mean","mean","mean","mean"), hr=c(6,7,8,6,7,8,6,7,8,6,7,8,6,7,8,6,7,8), actual=c(14,20,34,22,24,27,56,12,34,11,15,45,56,78,89,111,123,156), time_pos=c("today", "yesterday", "today", "yesterday", "today", "yesterday"))
x <- x[order(x$hr),]

plot <- function(df) {
  .pal <- RColorBrewer::brewer.pal(3, "Set2")[c(1, 3)]
  subplotList <- list()
  for(metric in unique(df$metrics)){
    showlegend <- metric == unique(df$metrics)[1]
    subplotList[[metric]] <- df[df$metrics == metric,] %>%
      plot_ly(
        x = ~ hr,
        y = ~ actual,
        color = ~ time_pos,
        colors = .pal,
        legendgroup = ~time_pos,
        showlegend = showlegend,
        hoverinfo = "text",
        hovertemplate = paste(
          "<b>%{text}</b><br>",
          "%{xaxis.title.text}: %{x:+.1f}<br>",
          "%{yaxis.title.text}: %{y:+.1f}<br>",
          "<extra></extra>"
        ),
        type = "scatter",
        mode = "lines+markers",
        marker = list(
          size = 7,
          color = "white",
          line = list(width = 1.5)
        ),
        width = 700,
        height = 620
      ) %>% 
      add_annotations(
        text = ~metrics,
        x = 0.5,
        y = 1,
        yref = "paper",
        xref = "paper",
        xanchor = "center",
        yanchor = "bottom",
        showarrow = FALSE,
        font = list(size = 15)
      ) %>% 
      layout(autosize = T, legend = list(font = list(size = 8)))
  }
  subplot(subplotList, nrows = length(subplotList), margin = 0.05)
}

plot(x)

【讨论】：