Skip to content

Commit

Permalink
move select crosstalk with plotly and DT to experiments dir
Browse files Browse the repository at this point in the history
  • Loading branch information
timelyportfolio committed Dec 17, 2017
1 parent eb4a6f3 commit d476b4c
Showing 1 changed file with 78 additions and 26 deletions.
104 changes: 78 additions & 26 deletions inst/experiments/select_crosstalk.R → experiments/select_crosstalk.R
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
library(sf)
library(plotly)
library(leaflet)
library(plotly)
library(crosstalk)
library(htmltools)

Expand Down Expand Up @@ -62,12 +62,22 @@ function(el,x) {
var id = String(lyr.options.layerId)
if(
!x.value ||
(Array.isArray(x.value) && x.value.indexOf(id) === -1)
(
Array.isArray(x.value) &&
x.value.filter(function(d) {
return d == id
}).length === 0
)
) {
toggle_state(lyr, false)
toggle_style(lyr, style_obj.false)
}
if(Array.isArray(x.value) && x.value.indexOf(id) > -1) {
if(
Array.isArray(x.value) &&
x.value.filter(function(d) {
return d == id
}).length > 0
) {
toggle_state(lyr, true)
toggle_style(lyr, style_obj.true)
}
Expand Down Expand Up @@ -99,29 +109,6 @@ function(el,x) {
)
}
if(ct_sel) {
var ct_values = ct_sel.value
var id = String(layer.options.layerId)
if(selected) {
if(!ct_values) {
ct_sel.set([id])
}
if(Array.isArray(ct_values) && ct_values.indexOf(id) === -1) {
ct_sel.set(ct_values.concat(id))
}
}
if(ct_values && !selected) {
ct_values.length > 1 ?
ct_sel.set(
ct_values.filter(function(d) {
return d !== id
})
) :
ct_sel.set(null) // select all if nothing selected
}
}
return selected;
};
// set up click handler on each layer with a group name
Expand All @@ -133,6 +120,35 @@ function(el,x) {
lyr.on('click',function(e){
var selected = toggle_state(e.target);
toggle_style(e.target, style_obj[String(selected)]);
if(ct_sel) {
var ct_values = ct_sel.value;
var id = lyr.options.layerId;
if(selected) {
if(!ct_values) {
ct_sel.set([id, String(id)]) // do both since Plotly uses String id
}
// use filter instead of indexOf to allow inexact equality
if(
Array.isArray(ct_values) &&
ct_values.filter(function(d) {
return d == id
}).length === 0
) {
ct_sel.set(ct_values.concat([id, String(id)])) // do both since Plotly uses String id
}
}
if(ct_values && !selected) {
ct_values.length > 1 ?
ct_sel.set(
ct_values.filter(function(d) {
return d != id
})
) :
ct_sel.set(null) // select all if nothing selected
}
}
});
}
});
Expand All @@ -146,6 +162,7 @@ function(el,x) {
)
}


browsable(
tagList(
tags$div(
Expand All @@ -165,3 +182,38 @@ browsable(
)
)
)


# try it with DT datatable
library(DT)

# no reason to carry the load of the feature column
# in the datatables
# so we will modify the data to subtract the feature column
# not necessary to use dplyr but select makes our life easy
# also need to modify targets, colnames, and container
dt <- datatable(boroughs_sd, width="100%")
dt$x$data <- dplyr::select(dt$x$data, -geometry)
dt$x$options$columnDefs[[1]]$targets <- seq_len(ncol(boroughs)-1)
attr(dt$x, "colnames") <- attr(dt$x, "colnames")[which(attr(dt$x, "colnames") != "geometry")]
dt$x$container <- gsub(x=dt$x$container, pattern="<th>geometry</th>\n", replacement="")
dt


browsable(
tagList(
tags$div(
style = "float:left; width: 49%;",
add_select_script(
map,
styleFalse = list(fillOpacity = 0.2, weight = 1, opacity = 0.4, color="black"),
styleTrue = list(fillOpacity = 0.7, weight = 3, opacity = 0.7, color="blue"),
ns = ""
)
),
tags$div(
style = "float:left; width: 49%;",
dt
)
)
)

3 comments on commit d476b4c

@tim-salabim
Copy link

@tim-salabim tim-salabim commented on d476b4c Feb 17, 2018

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@timelyportfolio I have hacked a modification into this (see below) to enable selection only on ctrl + click using if(e.originalEvent.ctrlKey){...}. Hence, the map renders normally and popups can be queried as usual. When ctrl button is pressed then clicking will make the selection and popups are disabled. Would you mind having a look at this (I'm sure there's a smarter way of achieving this - my approach is copy&paste from SO). Also, what are your thoughts on having ctrl+click as the default behaviour for the click GUIs in mapedit (e.g. `selectFeatures(x, mode = "ctrlClick"))?

library(sf)
library(leaflet)
library(crosstalk)
library(htmltools)
library(mapview)

# boroughs<- st_read("X:/Appelhans Tim/boroughs.geojson")
# boroughs$x <- seq(1:5)
# boroughs$y <- seq(2,10,2)

franconia_sd <- SharedData$new(
  franconia,
  key=~NUTS_ID,
  # provide explicit group so we can easily refer to this later
  group = "franconia"
)

map <- leaflet(franconia_sd) %>%
  addProviderTiles(providers$CartoDB.Positron) %>%
  addPolygons(
    data=franconia_sd,
    layerId = ~NUTS_ID,
    color = "#444444",
    weight = 1,
    smoothFactor = 0.5,
    opacity = 1.0,
    fillOpacity = 0.5,
    fillColor = ~colorQuantile("Greens", SHAPE_AREA)(SHAPE_AREA),
    popup = mapview::popupTable(franconia)
    #  turn off highlight since it interferes with selection styling
    #   if careful with styling could have both highlight and select
    #    highlightOptions = highlightOptions(color = "white", weight = 2)
  )

# borrow from https://github.com/r-spatial/mapedit/blob/master/R/query.R#L73-L132
#   to select/deselect features but instead of Shiny.onInputChange
#   use crosstalk to manage state
add_select_script <- function(lf, styleFalse, styleTrue, ns="") {
  ## check for existing onRender jsHook?
  
  htmlwidgets::onRender(
    lf,
    sprintf(
      "
      function(el,x) {
      var lf = this;
      var style_obj = {
      'false': %s,
      'true': %s
      }
      var crosstalk_group = '%s';
      // instead of shiny input as our state manager
      //   use crosstalk
      if(typeof(crosstalk) !== 'undefined' && crosstalk_group) {
      var ct_sel = new crosstalk.SelectionHandle()
      ct_sel.setGroup(crosstalk_group)
      ct_sel.on('change', function(x){
      if(x.sender !== ct_sel) { //ignore select from this map
      lf.eachLayer(function(lyr){
      if(lyr.options && lyr.options.layerId) {
      var id = String(lyr.options.layerId)
      if(
      !x.value  ||
      (
      Array.isArray(x.value) &&
      x.value.filter(function(d) {
      return d == id
      }).length === 0
      )
      ) {
      toggle_state(lyr, false)
      toggle_style(lyr, style_obj.false)
      }
      if(
      Array.isArray(x.value) &&
      x.value.filter(function(d) {
      return d == id
      }).length > 0
      ) {
      toggle_state(lyr, true)
      toggle_style(lyr, style_obj.true)
      }
      }
      })
      }
      })
      }
      // define our functions for toggling
      function toggle_style(layer, style_obj) {
      layer.setStyle(style_obj);
      };
      function toggle_state(layer, selected, init) {
      if(typeof(selected) !== 'undefined') {
      layer._mapedit_selected = selected;
      } else {
      selected = !layer._mapedit_selected;
      layer._mapedit_selected = selected;
      }
      if(typeof(Shiny) !== 'undefined' && Shiny.onInputChange && !init) {
      Shiny.onInputChange(
      '%s-mapedit_selected',
      {
      'group': layer.options.group,
      'id': layer.options.layerId,
      'selected': selected
      }
      )
      }
      return selected;
      };
      // set up click handler on each layer with a group name
      lf.eachLayer(function(lyr){
      if(lyr.on && lyr.options && lyr.options.layerId) {
      // start with all unselected ?
      toggle_state(lyr, false, init=true);
      toggle_style(lyr, style_obj[lyr._mapedit_selected]);
      lyr.on('click',function(e){
      console.log(e.originalEvent.ctrlKey)
      if(e.originalEvent.ctrlKey){
      var selected = toggle_state(e.target);
      toggle_style(e.target, style_obj[String(selected)]);
      if(ct_sel) {
      var ct_values = ct_sel.value;
      var id = lyr.options.layerId;
      if(selected) {
      if(!ct_values) {
      ct_sel.set([id, String(id)]) // do both since Plotly uses String id
      }
      // use filter instead of indexOf to allow inexact equality
      if(
      Array.isArray(ct_values) &&
      ct_values.filter(function(d) {
      return d == id
      }).length === 0
      ) {
      ct_sel.set(ct_values.concat([id, String(id)]))  // do both since Plotly uses String id
      }
      }
      if(ct_values && !selected) {
      ct_values.length > 1 ?
      ct_sel.set(
      ct_values.filter(function(d) {
      return d != id
      })
      ) :
      ct_sel.set(null) // select all if nothing selected
      }
      var nodes = document.getElementByClass('popup-pane').getElementsByTagName('*');
      //var nodes = document.getElementsByClassName('leaflet-popup-pane')[0].getElementsByTagName('*');
      for(var i = 0; i < nodes.length; i++){
      nodes[i].disabled = true;
      }
      }
      }
      });
      }
      });
      }
      ",
      jsonlite::toJSON(styleFalse, auto_unbox=TRUE),
      jsonlite::toJSON(styleTrue, auto_unbox=TRUE),
      if(inherits(getMapData(map), "SharedData")) {getMapData(map)$groupName()} else {""},
      ns
    )
  )
  }


# try it with DT datatable
library(DT)

# no reason to carry the load of the feature column
#   in the datatables
#   so we will modify the data to subtract the feature column
#   not necessary to use dplyr but select makes our life easy
#   also need to modify targets, colnames, and container
dt <- datatable(franconia_sd, width="100%")
dt$x$data <- dplyr::select(dt$x$data, -geometry)
dt$x$options$columnDefs[[1]]$targets <- seq_len(ncol(franconia)-1)
attr(dt$x, "colnames") <- attr(dt$x, "colnames")[which(attr(dt$x, "colnames") != "geometry")]
dt$x$container <- gsub(x=dt$x$container, pattern="<th>geometry</th>\n", replacement="")
dt


browsable(
  tagList(
    tags$div(
      style = "float:left; width: 49%;",
      add_select_script(
        map,
        styleFalse = list(fillOpacity = 0.2, weight = 1, opacity = 0.4, color="black"),
        styleTrue = list(fillOpacity = 0.7, weight = 3, opacity = 0.7, color="blue"),
        ns = ""
      )
    ),
    tags$div(
      style = "float:left; width: 49%;",
      dt
    )
  )
)

@timelyportfolio
Copy link
Owner Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Sure, will have a look as I work through testing new leaflet with mapedit over the weekend starting now :). Thanks!

@tim-salabim
Copy link

@tim-salabim tim-salabim commented on d476b4c Feb 17, 2018

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I should mention that I only got the suppressing of popups to work with leaflet 0.7.7, not 1.2 (current schloerke branch version). In the following, first line successfully prevents popups with 0.7.7 whereas second (commented out) line does not with 1.2.

var nodes = document.getElementByClass('popup-pane').getElementsByTagName('*');
      //var nodes = document.getElementsByClassName('leaflet-popup-pane')[0].getElementsByTagName('*');

Please sign in to comment.