Commit 0f5166e8 authored by Quentin Read's avatar Quentin Read
Browse files

comment out on-click stuff

parent d88ba355
......@@ -2,6 +2,7 @@
# Creates interactive ggalluvial plot
# This version now includes hovering tooltip on links and nodes, and detailed information displayed below plot on click.
# QDR 25 Oct 2020
# Modified 18 Nov 2020: now does not display any information on click.
### Initial setup
### =============
......@@ -90,7 +91,7 @@ ui <- fluidPage(
titlePanel("Systematic review of the literature assessing interdisciplinarity from 2000 to 2019"),
fluidRow(
p("Choose which profiles and waypoints to display. Hover over a pathway or waypoint to display information. Click on a pathway or waypoint for more detailed information.", style = "padding-left:25px"),
p("Choose which profiles and waypoints to display. Hover over a pathway or waypoint to display information.", style = "padding-left:25px"),
tags$br()
),
......@@ -145,12 +146,13 @@ ui <- fluidPage(
fluidRow(tags$div(
style = "position: relative;",
plotOutput("sankey_plot", height = "900px",
hover = hoverOpts(id = "plot_hover"),
click = clickOpts(id = "plot_click")),
hover = hoverOpts(id = "plot_hover")#,
# click = clickOpts(id = "plot_click")
),
htmlOutput("tooltip"))),
# Table of lit sources that will appear on click
fluidRow(dataTableOutput("click_info"), style = "padding-left:25px; padding-right:25px"),
# # Table of lit sources that will appear on click
# fluidRow(dataTableOutput("click_info"), style = "padding-left:25px; padding-right:25px"),
# Footer
fluidRow(
......@@ -342,49 +344,49 @@ server <- function(input, output, session) {
}
)
output$click_info <- DT::renderDataTable(
if(!is.null(input$plot_click)) {
click <- input$plot_click
x_coord <- round(click$x)
# Which columns to display in data table?
# Display the raw values for criterion, standard, and measure all the time.
columns_show <- c('LitSource', 'DOI', 'AuthorCriterion', 'AuthorStd', 'AuthorMeasure')
column_names <- variable_names$full_name[match(columns_show, variable_names$abbreviation)]
if(abs(click$x - x_coord) < (node_width / 2)) {
# Display what rows go through the node if mouse click is within a node "box"
box_labels <- axis_option_names
# Determine stratum (node) name from x and y coord, and the n.
node_row <- pbuilt$data[[2]]$x == x_coord & click$y > pbuilt$data[[2]]$ymin & click$y < pbuilt$data[[2]]$ymax
node_label <- pbuilt$data[[2]]$stratum[node_row]
node_n <- pbuilt$data[[2]]$n[node_row]
# Get all alluvia names corresponding to the stratum
alluvia <- pbuilt$data[[1]]$alluvium[pbuilt$data[[1]]$stratum == node_label]
flow_ids <- dat_plot_global$ID[alluvia]
structure(as.data.frame(unique(data5.cl[data5.cl$ID %in% flow_ids, columns_show])), names = column_names)
} else {
# Check whether the mouse click was on a polygon
click_within_flow <- sapply(polygon_coords, function(pol) point.in.polygon(point.x = click$x, point.y = click$y, pol.x = pol$x, pol.y = pol$y))
# Display what rows are included in the flow polygon clicked on by the mouse
if (any(click_within_flow)) {
# Find the alluvium that is plotted on top. (last)
coord_id <- rev(which(click_within_flow == 1))[1]
# Get the corresponding row ID from the main data frame
flow_id <- dat_plot_global$ID[coord_id]
# Get the subset of data frame that has all the characteristics matching that alluvium
data_row <- dat_plot_global[dat_plot_global$ID == flow_id, c('Cluster', input[['axes']])]
IDs_show <- dat_plot_global$ID[apply(dat_plot_global[, c('Cluster', input[['axes']])], 1, function(x) all(x == data_row))]
structure(as.data.frame(unique(data5.cl[data5.cl$ID %in% IDs_show, columns_show])), names = column_names)
}
}
}
)
# output$click_info <- DT::renderDataTable(
# if(!is.null(input$plot_click)) {
# click <- input$plot_click
# x_coord <- round(click$x)
#
# # Which columns to display in data table?
# # Display the raw values for criterion, standard, and measure all the time.
# columns_show <- c('LitSource', 'DOI', 'AuthorCriterion', 'AuthorStd', 'AuthorMeasure')
# column_names <- variable_names$full_name[match(columns_show, variable_names$abbreviation)]
#
# if(abs(click$x - x_coord) < (node_width / 2)) {
# # Display what rows go through the node if mouse click is within a node "box"
# box_labels <- axis_option_names
# # Determine stratum (node) name from x and y coord, and the n.
# node_row <- pbuilt$data[[2]]$x == x_coord & click$y > pbuilt$data[[2]]$ymin & click$y < pbuilt$data[[2]]$ymax
# node_label <- pbuilt$data[[2]]$stratum[node_row]
# node_n <- pbuilt$data[[2]]$n[node_row]
# # Get all alluvia names corresponding to the stratum
# alluvia <- pbuilt$data[[1]]$alluvium[pbuilt$data[[1]]$stratum == node_label]
# flow_ids <- dat_plot_global$ID[alluvia]
#
# structure(as.data.frame(unique(data5.cl[data5.cl$ID %in% flow_ids, columns_show])), names = column_names)
#
# } else {
# # Check whether the mouse click was on a polygon
# click_within_flow <- sapply(polygon_coords, function(pol) point.in.polygon(point.x = click$x, point.y = click$y, pol.x = pol$x, pol.y = pol$y))
# # Display what rows are included in the flow polygon clicked on by the mouse
# if (any(click_within_flow)) {
# # Find the alluvium that is plotted on top. (last)
# coord_id <- rev(which(click_within_flow == 1))[1]
# # Get the corresponding row ID from the main data frame
# flow_id <- dat_plot_global$ID[coord_id]
#
# # Get the subset of data frame that has all the characteristics matching that alluvium
# data_row <- dat_plot_global[dat_plot_global$ID == flow_id, c('Cluster', input[['axes']])]
# IDs_show <- dat_plot_global$ID[apply(dat_plot_global[, c('Cluster', input[['axes']])], 1, function(x) all(x == data_row))]
#
# structure(as.data.frame(unique(data5.cl[data5.cl$ID %in% IDs_show, columns_show])), names = column_names)
# }
# }
#
# }
# )
}
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment