rplotlycrosstalk

Filter source data for summary stats plot- using plotly and crosstalk in R

I am trying to adapt an example from here plotly-r.com/client-side-linking

The target is to filter the source data (txhousing) by year and produce the summary dot-plot of missing values by city. Here is my attempt but the filter is not working. Any suggestions without shiny?

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)
)
Solution

  • Here is an example of how to get a filter by year. This does not use crosstalk. I misspoke in my comment, from crosstalk: "Crosstalk currently only works ... not aggregate or summary views". (<< for the version of crosstalk used in R)

    So how can you do this?

    Data Prep

    You need two data subsets: the miss by city and by city & year.

    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)

    Data Filters/Buttons/Dropdown

    Now you need to tell Plotly what you want where, you do this in the call for layout, however we need a set for each filter/dropdown/button (whatever you want to call it - Plotly calls this a button, even if it's not literally a button).

    The first button I'll make is to match the parent - where all miss is grouped by city (not year). A button requires 3 arguments:

    This change isn't going to change the layout, so we need to use the method restyle. The label is the year (of all years, as it were). The args are going to be the changes to the x & y assigned data.

    The first button:

    # 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))))

    Note the use of list on the calls in args. This all get's translated to Javascript, so it's set up for that language's data structures (objects, arrays, and all that jazz).

    The remaining buttons follow a distinct pattern so I'm going lapply and loop through each of the unique year's in the data. I want the buttons to be in order by year, so I call sort, as well.

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

    The only clear difference between these buttons and the initial button we created is that here I create a data subset in the loop that pertains to that group specifically.

    Note that I did not sort the data by city, miss, nor make it a factor.

    # 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?
  )
})

    Data Plotting

    We're ready to plot. This plot adds one additional argument to layout(yaxis = list(.... I used categoryorder to tell Plotly that the order of the categories on the yaxis are dependent on the total values assigned on the xaxis. In your code, it was done in the plot call: y = ~forcats::fct_reorder(city, miss).

    Within the layout, within updatemenus, I have 2 additional arguments (other than buttons): x and y. These give the location of where the button(s) should be placed. If you're not aware, Plotly assigns a domain of [0, 1] to both the x & y plot space. So any value that's less than zero or greater than 1 is outside of the plot space. (For example, the title typically not on top of the plot, it's above it, outside of the plot space.)

    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

    all years 2006

    You may have noticed a lot of nested list(list... That's because there are options within options, whether you use them or not. This method of nesting ensures that Plotly can translate what you want into Javascript.

    Here's all the code you need to put this together, all in one place. (easier copy + paste)

    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

    If you have any questions, let me know.