过滤源数据以获取摘要统计图 - 在 R 中使用绘图和串扰

Question

我正在尝试改编这里的示例plotly-r.com/client-side-linking

目标是按年份过滤源数据（txhousing）并按城市生成缺失值的汇总点图。 这是我的尝试，但过滤器不起作用。 有没有没有闪亮的建议？

library(plotly)
library(crosstalk)

data(txhousing, package = "ggplot2")

tx <- highlight_key(txhousing, ~city)

# initiate a plotly object
base <- plot_ly(tx, color = I("black"))


dot_plot <- base %>% group_by(city) %>% 

  summarise(miss = sum(is.na(median))) %>%
  filter(miss > 0) %>%
  add_markers(
    x = ~miss, 
    y = ~forcats::fct_reorder(city, miss), 
    hoverinfo = "x+y"
  ) %>%
  layout(
    xaxis = list(title = "Number of months missing"),
    yaxis = list(title = "")
  ) 

bscols(
  filter_select("f","select year", tx, ~year),
  dot_plot,
  widths = c(4,8)
)

Answer 1

以下是如何按年份获取过滤器的示例。这不使用

crosstalk

。我在评论中说错了，来自

crosstalk

：“Crosstalk 目前只起作用......而不是聚合或摘要视图”。 (<< for the version of crosstalk used in R)

那么你怎么能做到这一点呢？

数据准备

您需要两个数据子集：

miss

（按城市）和按城市和年份。

library(plotly)

data(txhousing, package = "ggplot2")

txAll <- group_by(txhousing, city) %>%        # data grouped by all years
  summarise(miss = sum(is.na(median))) %>% filter(miss > 0)

tx <- group_by(txhousing, city, year) %>%     # data grouped by each year
  summarise(miss = sum(is.na(median))) %>%  filter(miss > 0)

数据过滤器/按钮/下拉菜单

现在你需要告诉 Plotly 你想要什么，在哪里，你可以在

layout

的调用中执行此操作，但是我们需要一组 each 过滤器/下拉菜单/按钮（无论你想怎么称呼它 - Plotly 称之为

） button

，即使它不是字面上一个按钮）。

我要做的第一个按钮是匹配父级 - 所有

miss

按城市（而不是年份）分组。

button

需要 3 个参数：

• 方法：本质上除以更改是布局还是绘图调用
• 标签：在下拉菜单中、按钮上（或以其他方式显示）中的名称
• args：选择此选项时需要更改的内容

此更改不会改变布局，因此我们需要使用方法

restyle

。标签是年份（可以说是所有年份）。

args

将是对 x 和 y 指定数据的更改。

第一个按钮：

# create a button to return plot to the original state, with all years
btn1 <- list(method = "restyle", label = "All Years",
             args = list(list(x = list(txAll$miss), y = list(txAll$city))))

请注意在

list

中的调用中使用

args

。这一切都被翻译成 Javascript，因此它是为该语言的数据结构（对象、数组和所有爵士乐）设置的。

其余按钮遵循不同的模式，因此我将

lapply

并循环遍历数据中每个独特的

year

。我希望按钮按年份排列，所以我也调用

sort

。

sort(unique(tx$year))[k]  # where k is the value we iterate over in lapply

这些按钮与我们创建的初始按钮之间唯一明显的区别是，这里我在循环中创建了一个专门属于该组的数据子集。

请注意，我没有按城市对数据进行排序，错过了，也没有将其作为一个因素。

# for each year, create a menu item (aka: dropdown item, button, data group)
btns <- lapply(1:length(unique(tx$year)), function(k) {  # create by sorted years
  tx2 <- tx[tx$year == sort(unique(tx$year))[k], ]       # filter for year
                # method: restyle (data change); label: how it is named for user 
  list(method = "restyle", label = sort(unique(tx$year))[k],
       args = list(list(x = list(tx2$miss), y = list(tx2$city))) # args: what's changing?
  )
})

数据绘图

我们准备好策划了。该图为

layout(yaxis = list(...

添加了一个附加参数。我使用

categoryorder

告诉 Plotly，

yaxis

上的类别顺序取决于

xaxis

上指定的总值。在您的代码中，它是在绘图调用中完成的：

y = ~forcats::fct_reorder(city, miss)

。

在

layout

中，在

updatemenus

中，我有 2 个附加参数（除了

buttons

之外）：x 和 y。这些给出了按钮应放置的位置。如果您不知道，Plotly 会将

[0, 1]

域分配给 x 和 y 绘图空间。因此任何小于零或大于 1 的值都在绘图空间之外。 （例如，标题通常不在绘图的顶部，而是在绘图上方、绘图空间之外。）

plot_ly(type = "scatter", mode = "markers", data = txAll,
        x = ~miss, y = ~city) %>%                         # create initial plot
  layout(yaxis = list(categoryorder = "total ascending", title = ""),  # y category order
         xaxis = list(title = "Number of months missing"),     
         updatemenus = list(           
           list(x = 0, y = 1.1,                       # location of dropdown
                buttons = append(list(btn1), btns)))) # provide the buttons

你可能已经注意到了很多嵌套

list(list...

那是因为选项中还有选项，无论你是否使用它们。这种嵌套方法确保 Plotly 可以将您想要的内容翻译成 Javascript。

这里是将其组合在一起所需的所有代码，全部集中在一个位置。 （更容易复制+粘贴）

library(plotly)

data(txhousing, package = "ggplot2")

txAll <- group_by(txhousing, city) %>%        # data grouped by all years
  summarise(miss = sum(is.na(median))) %>% filter(miss > 0)

tx <- group_by(txhousing, city, year) %>%     # data grouped by each year
  summarise(miss = sum(is.na(median))) %>%  filter(miss > 0)

# create a button to return plot to the original state, with all years
btn1 <- list(method = "restyle", label = "All Years",
             args = list(list(x = list(txAll$miss), y = list(txAll$city))))
# for each year, create a menu item (aka: dropdown item, button, data group)
btns <- lapply(1:length(unique(tx$year)), function(k) {  # create by sorted years
  tx2 <- tx[tx$year == sort(unique(tx$year))[k], ]       # filter for year
                # method: restyle (data change); label: how it is named for user 
  list(method = "restyle", label = sort(unique(tx$year))[k],
       args = list(list(x = list(tx2$miss), y = list(tx2$city))) # args: what's changing?
  )
})

plot_ly(type = "scatter", mode = "markers", data = txAll,
        x = ~miss, y = ~city) %>%                         # create initial plot
  layout(yaxis = list(categoryorder = "total ascending", title = ""),  # y category order
         xaxis = list(title = "Number of months missing"),     
         updatemenus = list(           
           list(x = 0, y = 1.1,                       # location of dropdown
                buttons = append(list(btn1), btns)))) # provide the buttons

如果您有任何疑问，请告诉我。