使用R中的下拉菜单向绘图添加图例

hc2pp10m  于 2023-03-05  发布在  其他
关注(0)|答案(1)|浏览(107)

我编写了下面的代码来生成一个带有两个下拉菜单的绘图。

library(dplyr)
library(plotly)

# initial setup
iris.col <- factor(iris$Species, label = c("red", "blue", "green"))
iris.symbol <- factor(iris$Species, labels = c("diamond", "cross", "square"))

plot <- plot_ly(data = iris, x = ~Sepal.Length, y = ~Sepal.Width, 
                marker = list(color = alpha(as.character(iris.col), 0.2), 
                              symbol = ~iris.symbol, size = 8, 
                              line = list(color = 'rgb(0, 0, 0)', width = 1)),
                type = "scatter", mode = "markers", text = ~Species,
                hovertemplate = paste('<i>Species</i>: %{text}',
                                      '<br><b>X</b>: %{x}<br>',
                                      '<b>Y</b>: %{y}'))

# X variable
x_var<-list(
  type = "list",
  x = 0.2,
  xanchor = "left",
  y = 1.2,
  buttons = list(
    list(
      method = "update",
      args = list(list(x = list(iris$Sepal.Length)),
                  list(xaxis = list(title = "Sepal.Length"))),
      label = "Sepal.Length"
    ),
    list(
      method = "update",
      args = list(list(x =list(iris$Sepal.Width)),
                  list(xaxis = list(title = "Sepal.Width"))),
      label = "Sepal.Width"
    ),
    list(
      method = "update",
      args = list(list(x = list(iris$Petal.Length)),
                  list(xaxis = list(title = "Petal.Length"))),
      label = "Petal.Length"
    ),
    list(
      method = "update",
      args = list(list(x = list(iris$Petal.Width)),
                  list(xaxis = list(title = "Petal.Width"))),
      label = "Petal.Width"
    )
  )
)

# Y variable
y_var<-list(
  type = "list",
  x = 0.8,
  xanchor = "left",
  y = 1.2,
  buttons = list(
    list(
      method = "update",
      args = list(list(y = list(iris$Sepal.Length)),
                  list(yaxis = list(title = "Sepal.Length"))),
      label = "Sepal.Length"
    ),
    list(
      method = "update",
      args = list(list(y =list(iris$Sepal.Width)),
                  list(yaxis = list(title = "Sepal.Width"))),
      label = "Sepal.Width"
    ),
    list(
      method = "update",
      args = list(list(y = list(iris$Petal.Length)),
                  list(yaxis = list(title = "Petal.Length"))),
      label = "Petal.Length"
    ),
    list(
      method = "update",
      args = list(list(y = list(iris$Petal.Width)),
                  list(yaxis = list(title = "Petal.Width"))),
      label = "Petal.Width"
    )
  )
)

# add layout
plot <- plot %>% layout(
  updatemenus = list(x_var,y_var),
  showlegend = TRUE,
  annotations = list(
    list(
      text = "<b>X-Axis:</b>", x=0.04, y=1.18, 
      xref='paper', yref='paper',xanchor = "left", showarrow=FALSE
    ),
    list(
      text = "<b>Y-Axis:</b>", x=0.63, y=1.18, 
      xref='paper', yref='paper',xanchor = "left", showarrow=FALSE
    )
  )
)
#make the plot
plot

我得到了这个图：

但是，我无法基于物种向图中添加图例。我尝试过这个帖子R+Plotly: Customize Legend Entries，它使用add_trace来设置每个图例类。
但是这个方法使得当我从下拉菜单中选择变量时，标记的颜色不再起作用。也许有人会有一些解决办法。

r

1条答案

按热度按时间
rta7y2nd

rta7y2nd1#

更新

您发现轴标题没有更新。通过使用ifelse，我在btn函数中删除了轴标题的更改。
下面是对该函数的更新。标题现在按预期更新。其余代码和代码解释保持不变。

btn <- function(xLoc, m, nms, xOry) { # x btn position, method, names, x or y
  list(type = "list", x = xLoc, xanchor = "left", y = 1.2, 
       buttons = lapply(
         nms, function(k) {           # iterate over names
           if(xOry == "x") { # is this creating x or y btns?
             args = list(    # a list for each trace (each legend entry)
               list(x = list(ia[, k], ib[, k], ic[, k])),  # 3 lists, 3 traces
               list(xaxis = list(title = k)))
           } else {
             args = list(    # a list for each trace (each legend 
               list(y = list(ia[, k], ib[, k], ic[, k])),  # 3 lists, 3 traces
               list(yaxis = list(title = list(text = k))))
           }
           list(
             method = m, label = k, args = args)
       })
  )
}
所有代码在一起

下面是更新函数的所有代码。

library(dplyr)
library(plotly)

# initial setup
iris.col <- factor(iris$Species, label = c("red", "blue", "green"))
iris.symbol <- factor(iris$Species, labels = c("diamond", "cross", "square"))

(plt <- plot_ly(data = iris, x = ~Sepal.Length, y = ~Sepal.Width, 
                split = ~Species,                                # <- I'm new
                marker = list(color = alpha(as.character(iris.col), 0.2), 
                              symbol = ~iris.symbol, size = 8, 
                              line = list(color = 'rgb(0, 0, 0)', width = 1)),
                type = "scatter", mode = "markers", text = ~Species,
                hovertemplate = paste('<i>Species</i>: %{text}',
                                      '<br><b>X</b>: %{x}<br>',
                                      '<b>Y</b>: %{y}')))

ia <- iris[iris$Species == levels(iris$Species)[1],] # df for each species
ib <- iris[iris$Species == levels(iris$Species)[2],]
ic <- iris[iris$Species == levels(iris$Species)[3],]

btn <- function(xLoc, m, nms, xOry) { # x btn position, method, names, x or y
  list(type = "list", x = xLoc, xanchor = "left", y = 1.2, 
       buttons = lapply(
         nms, function(k) {           # iterate over names
           if(xOry == "x") { # is this creating x or y btns?
             args = list(    # a list for each trace (each legend entry)
               list(x = list(ia[, k], ib[, k], ic[, k])),  # 3 lists, 3 traces
               list(xaxis = list(title = k)))
           } else {
             args = list(    # a list for each trace (each legend 
               list(y = list(ia[, k], ib[, k], ic[, k])),  # 3 lists, 3 traces
               list(yaxis = list(title = list(text = k))))
           }
           list(
             method = m, label = k, args = args)
       })
  )
}

# add layout
plot2 <- plt %>% layout(
  updatemenus = list(btn(.2, "update", names(iris)[-5], "x"),  # <- I'm new
                     btn(.8, "update", names(iris)[-5], "y")), # <- I'm new
  showlegend = TRUE,
  annotations = list(
    list(
      text = "<b>X-Axis:</b>", x=0.04, y=1.18, 
      xref='paper', yref='paper',xanchor = "left", showarrow=FALSE
    ),
    list(
      text = "<b>Y-Axis:</b>", x=0.63, y=1.18, 
      xref='paper', yref='paper',xanchor = "left", showarrow=FALSE
    )
  )
)
#make the plot
plot2

原始答案

按颜色分隔时，或者在本例中定义图例时，Plotly将数据拆分为三个不同的跟踪。通过update发送数据时，发送了一个包含150个值的数组，而以前只有50个值。
您需要为 * 每个 * 跟踪定义x和y。
我没有像你写的那样编写冗长的个性化按钮代码，而是写了一个函数来完成大部分工作。在这个函数的args中：

  1. ifelse，这是为x或y创建按钮吗？（我最初使用setNames，但Plotly不喜欢所有的噪音，所以使用ifelse。）
    1.在x =或y =中，您将注意到 * 三个 * 列表，每个跟踪一个
    1.对于布局更新（轴标题），仍然只有一个列表，因为只有一个布局
使其工作的函数和辅助代码：
ia <- iris[iris$Species == levels(iris$Species)[1],] # df for each species
ib <- iris[iris$Species == levels(iris$Species)[2],]
ic <- iris[iris$Species == levels(iris$Species)[3],]

btn <- function(xLoc, m, nms, xOry) { # btn pos, method, names, x or y?
  list(type = "list", x = xLoc, xanchor = "left", y = 1.2, # from original code 
       buttons = lapply(
         nms, function(k) {           # iterate over names
           list(
             method = m, label = k, 
             args = ifelse(           # is this creating x or y btns?
               xOry == "x", 
               list(   # data list for each trace (each legend entry)
                 list(x = list(ia[, k], ib[, k], ic[, k])),  # 3 lists, 3 traces
                 list(xaxis = list(title = k))),
               list(
                 list(y = list(ia[, k], ib[, k], ic[, k])),  # 3 lists, 3 traces
                 list(yaxis = list(title = k)))
               )
             )
         })
  )
}
情节

这与原始代码几乎相同，唯一的区别是参数split = ~Species和括号中的换行。**括号允许您同时创建和渲染对象。

(plt <- plot_ly(data = iris, x = ~Sepal.Length, y = ~Sepal.Width, 
                split = ~Species,                                # <- I'm new
                marker = list(color = alpha(as.character(iris.col), 0.2), 
                              symbol = ~iris.symbol, size = 8, 
                              line = list(color = 'rgb(0, 0, 0)', width = 1)),
                type = "scatter", mode = "markers", text = ~Species,
                hovertemplate = paste('<i>Species</i>: %{text}',
                                      '<br><b>X</b>: %{x}<br>',
                                      '<b>Y</b>: %{y}')))
布局

最后但并非最不重要的是layout，唯一的变化是在对updatemenus的调用中，而不是最初创建的对象x_var和y_var，我调用了我创建的函数btn。
这些参数调用按钮在x轴上的位置、方法（"update"）、按钮标签的列名以及按钮是x还是y。

# add layout
plot2 <- plt %>% layout( # btn pos, method, names, x or y?
  updatemenus = list(btn(.2, "update", names(iris)[-5], "x"),  # <- I'm new
                     btn(.8, "update", names(iris)[-5], "y")), # <- I'm new
  showlegend = TRUE,
  annotations = list(
    list(
      text = "<b>X-Axis:</b>", x=0.04, y=1.18, 
      xref = 'paper', yref = 'paper',xanchor = "left", showarrow = FALSE
    ),
    list(
      text = "<b>Y-Axis:</b>", x=0.63, y=1.18, 
      xref = 'paper', yref = 'paper',xanchor = "left", showarrow = FALSE
    )
  )
)

你已经看到的所有代码

这是一个块中的所有代码（更容易复制+粘贴）。它是渲染绘图所需的一切。

library(dplyr)
library(plotly)

# initial setup
iris.col <- factor(iris$Species, label = c("red", "blue", "green"))
iris.symbol <- factor(iris$Species, labels = c("diamond", "cross", "square"))

(plt <- plot_ly(data = iris, x = ~Sepal.Length, y = ~Sepal.Width, 
                split = ~Species,                                # <- I'm new
                marker = list(color = alpha(as.character(iris.col), 0.2), 
                              symbol = ~iris.symbol, size = 8, 
                              line = list(color = 'rgb(0, 0, 0)', width = 1)),
                type = "scatter", mode = "markers", text = ~Species,
                hovertemplate = paste('<i>Species</i>: %{text}',
                                      '<br><b>X</b>: %{x}<br>',
                                      '<b>Y</b>: %{y}')))

ia <- iris[iris$Species == levels(iris$Species)[1],] # df for each species
ib <- iris[iris$Species == levels(iris$Species)[2],]
ic <- iris[iris$Species == levels(iris$Species)[3],]

btn <- function(xLoc, m, nms, xOry) { # x btn position, method, names, x or y
  list(type = "list", x = xLoc, xanchor = "left", y = 1.2, 
       buttons = lapply(
         nms, function(k) {           # iterate over names
           list(
             method = m, label = k,
             args = ifelse(           # is this creating x or y btns?
               xOry == "x", 
               list(   # a list for each trace (each legend entry)
                 list(x = list(ia[, k], ib[, k], ic[, k])),  # 3 lists, 3 traces
                 list(xaxis = list(title = k))),
               list(
                 list(y = list(ia[, k], ib[, k], ic[, k])),  # 3 lists, 3 traces
                 list(yaxis = list(title = k)))
             )
           )
         })
  )
}

# add layout
plot2 <- plt %>% layout(
  updatemenus = list(btn(.2, "update", names(iris)[-5], "x"),  # <- I'm new
                     btn(.8, "update", names(iris)[-5], "y")), # <- I'm new
  showlegend = TRUE,
  annotations = list(
    list(
      text = "<b>X-Axis:</b>", x=0.04, y=1.18, 
      xref='paper', yref='paper',xanchor = "left", showarrow=FALSE
    ),
    list(
      text = "<b>Y-Axis:</b>", x=0.63, y=1.18, 
      xref='paper', yref='paper',xanchor = "left", showarrow=FALSE
    )
  )
)
#make the plot
plot2
赞(0）分享  回复(0）举报  2023-03-05
我来回答

相关问题

    查看更多

    热门标签

    更多
    JavaquerypythonNode开发语言requestUtil数据库Table后端算法LoggerMessageElementParser

    最新问答

    更多
    • 蜀ICP备13028337号-1 大数据知识库 https://www.saoniuhuo.com © All rights reserved
    • 本站内容来源互联网,如果侵犯您的权益请联系我们删除, 联系方式：448109455@qq.com