R语言 下拉菜单选择x,y和颜色(绘图)

kpbwa7wx  于 2023-11-14  发布在  其他
关注(0)|答案(2)|浏览(98)

我试图创建一个plotly图与可选的x,y和颜色变量,部分基于this previous question。x和y变量选择似乎工作,但当新的x和y变量被选择,点颜色丢失。
此外,我尝试使用类似的策略来选择点颜色,但不幸的是,这似乎不起作用。
另一种选择是在前面链接的问题中使用“设置可见”策略。

示例:

library(plotly)
library(pcaMethods)

pca <- pcaMethods::pca(mtcars, nPcs=3)

df <- as.data.frame(pca@scores)

colors1 <- sample(c("red", "green", "blue"), nrow(df), replace=TRUE)
colors2 <- sample(c("red", "green", "blue"), nrow(df), replace=TRUE)

p <- plotly::plot_ly(df, x = ~PC1, y = ~PC2, type = "scatter",
    color = sample(c("red", "green", "blue"), nrow(df), replace=TRUE),
    mode = "markers") 

p <-  plotly::layout(
    p,
    title = "Dropdown PCA plot",
    updatemenus = list(
        list(
            y = 0.7,
            buttons = list(
                list(method = "restyle",
                   args = list(
                    "x", list(df$PC1)
                    ),
                   label = "PC1"),
                list(method = "restyle",
                   args = list(
                    "x", list(df$PC2)
                    ),
                   label = "PC2"),
                list(method = "restyle",
                   args = list(
                    "x", list(df$PC3)
                    ),
                   label = "PC3")
                )
            ),
        list(
            y = 0.5,
            buttons = list(
                list(method = "restyle",
                   args = list(
                    "y", list(df$PC1)
                    ),
                   label = "PC1"),
                list(method = "restyle",
                   args = list(
                    "y", list(df$PC2)
                    ),
                   label = "PC2"),
                list(method = "restyle",
                   args = list(
                    "y", list(df$PC3)
                    ),
                   label = "PC3")
                )
            )
        )
    )

htmlwidgets::saveWidget(p, "test.html", selfcontained=FALSE)

字符串

hk8txs48

hk8txs481#

这在R API中目前是不可能的,因为从变量到绘图输出的Map是在R端完成的,而不是由plotly.js完成的。
这在以下链接中解释:https://github.com/ropensci/plotly/issues/803
这个功能可以使用plotly.js和HTML来实现。需要在HTML页面中添加select元素,并添加事件侦听器来在更新时调用Plotly.newPlot()
这里可以看到一个示例实现:https://github.com/Alanocallaghan/plotlyutils/blob/master/inst/htmlwidgets/lib/selectable_scatter_plot/selectable_scatter_plot.js

jtoj6r0c

jtoj6r0c2#

我创建了一个基本函数,它使用plotly生成一系列散点图来比较输入框中的列,并为用户添加了一个菜单来选择不同的比较。
函数如下:

#' Use interactive scatter plots to compare distributions using plotly
#'
#' For each column provided function will plot a comparison scatter plot and
#' use a dropdown menu for user to select different comparisons
#' @param distributions dataframe of distributions to plot
#' @param title_prefix prefix to use in each scatter plot title
#' @param caption_x x position of caption. Defaults to 1 (right).
#' @param caption_y y position of caption. Defaults to -0.1 (bottom).
compare_distributions_scatter <- function(
    distributions,
    title_prefix,
    dropdown_x = 1.25, dropdown_y = 3.8
) {
  # Initialise a plotly plot
  scatter <- plot_ly()
  
  # Note possible comparisons of columns to compare
  column_names <- colnames(distributions)
  combinations <- combn(column_names, m = 2)
  n_combinations <- length(combinations)

  # Initialise a nested list structure to create settings for comparison plots
  dropdown_button_info <- list()
  
  # Examine each combination
  for (index in seq_len(ncol(combinations))) {
    ## Creating comparison plot
    
    # Get data source names
    x_source <- combinations[1, index]
    y_source <- combinations[2, index]
    
    # Get X and Y values
    x_values <- distributions[, x_source]
    y_values <- distributions[, y_source]

    # Add plot comparing two current distributions
    scatter <- scatter %>% add_trace(
      x = x_values, y = y_values,
      type = "scatter", mode = "markers",
      marker = list(color = "black", opacity = 0.75),
      visible = index == 1
    )

    ## Adding to button info
    
    # Build visibility values vector
    visibility <- rep(FALSE, n_combinations)
    visibility[index] <- TRUE
    
    # Add dropdown button info for current comparison plot
    dropdown_button_info[[index]] <- list(
      label = paste0(x_source, "-", y_source),
      method = "update",
      args = list(
        list(visible = visibility),
        list(
          title = paste0(
            title_prefix, " from ", x_source, " and ", y_source
          ),
          xaxis = list(title = x_source),
          yaxis = list(title = y_source)
        )
      )
    )
  }
  
  # Set initial plotting title
  scatter <- scatter %>%
    layout(
      title = paste0(
        title_prefix, " from ", column_names[1], " and ", column_names[2]
      ),
      xaxis = list(title = column_names[1]),
      yaxis = list(title = column_names[2]),
      showlegend = FALSE
    )

  # Add buttons to switch between comparisons
  scatter <- scatter %>% layout(
    updatemenus = list(
      list(x = dropdown_x, y = dropdown_y, buttons = dropdown_button_info)
    )
  )

  # Show plot
  scatter
}

字符串
使用上述函数,您可以创建比较图:

compare_distributions_scatter(
  distributions = mtcars[, c("mpg", "disp", "drat", "qsec")],
  title_prefix = "Comparing car info"
)


生成:

相关问题