RobertASmith commented 8 months ago

Hi @W-Mohammed @bitowaqr I am trying to add a hyperlink to the hover:

Do you know how to add in the HTML for the file so that the specific R file pops up in Rstudio, the HTML below doesn't work:

https://github.com/dark-peak-analytics/assertHE/blob/1291e087ed0c2cebf6fd5ec546248526fef3da20/R/project_visualiser.R#L303

This should be replicable by cloning and running the below (changing the project path to match yours).

rm(list = ls())

devtools::load_all(".")

# project_path <- testthat::test_path(paste0("example_project"))
 project_path <- "C:/Users/r_a_s/Documents/Projects/GSK/gskVEOutils"
#project_path <- "C:/Users/r_a_s/Documents/Projects/GSK/gsk_CLD_model"

visualise_project(project_path = project_path,
                  foo_path = "R",
                  test_path = "tests/testthat")

RobertASmith commented 7 months ago

Had some feedback, which I agree with, outlining how important this is. @W-Mohammed are you able to look into it further?

W-Mohammed commented 7 months ago

Hi @RobertASmith, I have spent some time working on this issue, and here is a quick update.

Hocking a JavaScript function on the file/test locations might do the trick. The idea is that once the file/test location is clicked, the JavaScript function is called, and the target file is opened in Rstudio. Please check the screenshot below for where the JavaScript function was injected into the existing functions.

However, I did not find a way to inject the JavaScript function into the network object properly. My last attempt at this was when I added the following code to the visualise_project function.

But it did not work, as evidenced by the screenshot below (one of the many trials using the above functions).

Also, you can see from the screenshot above that while the file/test links are valid, the browser cannot access the file (as a text editor). I chased this, and while there is a solution, it is impractical for the assertHE package; users would have to grant the browser access to the tested package folder.
On a positive note, the intended functionality works through shiny, as seen below.

https://github.com/dark-peak-analytics/assertHE/assets/58259938/7a69e31a-50ee-422c-83de-6d25169f7e7c

But for some reason the browser/shiny refreshes everytime a linked file is accessed.

W-Mohammed commented 7 months ago

Had some feedback, which I agree with, outlining how important this is. @W-Mohammed are you able to look into it further?

Can you please elaborate on the feedback you received?

RobertASmith commented 7 months ago

Yeah I think we will have to use shiny, the benefit of being able to click through is substantial for reviewers - copy-pasting + searching would be very frustrating. Thanks for this, very useful guidance.

RobertASmith commented 7 months ago

Had some feedback, which I agree with, outlining how important this is. @W-Mohammed are you able to look into it further?

Can you please elaborate on the feedback you received?

I'll catch you up in our next meeting

nialldavison commented 7 months ago

The aforementioned feedback didn't come from me, but I agree would be great for this to function as intended.

It's difficult to see what code is actually being used in your tests above (via the screenshots and videos), but to avoid the shiny app refreshing, it's possible that you'd need to add target="_blank" to the a() html. For JS, it would be window.open(url , '_blank');.

W-Mohammed commented 7 months ago

Thanks, @nialldavison, for the feedback. The issue was with the a() HTML. This is now fixed, and the app works as I expected.

https://github.com/dark-peak-analytics/assertHE/assets/58259938/d6db43eb-f188-4618-81e0-8efda73f8d4d

Here are some more information about the code I was playing with.

The test code below assumes that devtools::load_all() is called from main branch.

The plot network is updated with a JavaScript hook.

#' Plot Network
#'
#' Visualize a network plot using the visNetwork package.
#'
#' @param df_edges A data frame containing columns "from" and "to" representing the edges of the network.
#' @param from_col Name of the column in df_edges representing the source nodes.
#' @param to_col Name of the column in df_edges representing the target nodes.
#' @param df_summary A summary dataframe containing the information about each function.
#' @param df_coverage a summary dataframe with function names and test coverages
#' @param color_no_test named vector with hexcodes for background, border and highlight
#' @param color_with_test named vector with hexcodes for background, border and highlight
#' @param color_mod_coverage named vector with hexcodes for background, border and highlight where coverage moderate
#' @param moderate_coverage_range vector of two values giving range defined as moderate coverage.
#'
#' @return A visNetwork object representing the network plot.
#'
#' @examples
#' \dontrun{
#' # Plot a network from a data frame of edges
#' plotNetwork(df_edges)
#' }
#'
#' @export
#' @importFrom visNetwork visNetwork visEdges visOptions
#' @importFrom dplyr rename
#' @importFrom htmltools a
plotNetwork <- function(df_edges,
                    from_col = "from",
                    to_col = "to",
                    df_summary,
                    df_coverage,
                    color_no_test = c("background" = "#fad1d0", "border" = "#9c0000", "highlight" = "#9c0000"),
                    color_with_test = c("background" = "#e6ffe6", "border" = "#65a765", "highlight" = "#65a765"),
                    color_mod_coverage = c("background" = "#FFD580", "border" = "#E49B0F", "highlight" = "#E49B0F"),
                    moderate_coverage_range = c(0.2, 0.8)) {
# Check input validity
assertthat::assert_that(is.data.frame(df_edges),
        from_col %in% colnames(df_edges),
        to_col %in% colnames(df_edges))

# Extract unique nodes from the dataframe
df_nodes <- processNodes(df_edges = df_edges,
                       from_col = from_col,
                       to_col = to_col)

df_node_info <- df_summary[, c("foo_string", "foo_location", "test_location")]

# add in foo locations and test location to function strings in the edge dataframe
df_node_info <-
df_node_info[!duplicated(df_node_info[ , "foo_string"]), ] |>
merge(y = df_nodes,
      by.x = "foo_string",
      by.y =  "id",
      all.y = T)

# add in coverage
foo_string_rename <- c("id" = "foo_string")
if (!is.null(df_coverage)) {
df_node_info <- df_node_info |>
  merge(y = df_coverage,
        by = "foo_string",
        all.x = T) |>
  dplyr::rename(dplyr::all_of(foo_string_rename))
} else{
df_node_info <- df_node_info |>
  dplyr::mutate(coverage = NA) |>
  dplyr::rename(dplyr::all_of(foo_string_rename))
}

# create the html for the toggle...
foo_paths <- df_node_info$foo_location
test_paths <- df_node_info$test_location

df_nodes$title <- paste0(
"Foo Name: ",
df_node_info$label,
"<br>Foo Location: <a href=\"#\" onclick=\"openInRStudio('",
foo_paths, "'); event.preventDefault();\">",
df_node_info$foo_location, "</a>",
# skip "Test location" if coverage is 0%, cleaned_test_path == "".
ifelse(
  test = test_paths == "",
  yes = "",
  no = paste0(
    "<br>Test location: <a href=\"#\" onclick=\"openInRStudio('",
    test_paths, "'); event.preventDefault();\">",
    df_node_info$test_location, "</a>"
  )
),
"<br>Coverage: ",
paste0(df_node_info$coverage * 100, "%")
)

# define the colors based upon tests
df_nodes$color.background <- ifelse(test = is.na(df_node_info$test_location),
                                  yes = color_no_test["background"],
                                  no  = color_with_test["background"])

df_nodes$color.border <- ifelse(test = is.na(df_node_info$test_location),
                                  yes = color_no_test["border"],
                                  no  = color_with_test["border"])

df_nodes$color.highlight <- ifelse(test = is.na(df_node_info$test_location),
                                 yes = color_no_test["highlight"],
                                 no  = color_with_test["highlight"])

# if code coverage is not all nulls
if(any(!is.na(df_node_info$coverage))){

df_nodes$color.background <- ifelse(test = between(x = df_node_info$coverage,
                                                   left = moderate_coverage_range[1],
                                                   right = moderate_coverage_range[2]),
                                    yes = color_mod_coverage["background"],
                                    no  = df_nodes$color.background)

df_nodes$color.border <- ifelse(test = between(x = df_node_info$coverage,
                                                   left = moderate_coverage_range[1],
                                                   right = moderate_coverage_range[2]),
                                    yes = color_mod_coverage["border"],
                                    no  = df_nodes$color.border)

df_nodes$color.highlight <- ifelse(test = between(x = df_node_info$coverage,
                                               left = moderate_coverage_range[1],
                                               right = moderate_coverage_range[2]),
                                yes = color_mod_coverage["highlight"],
                                no  = df_nodes$color.highlight)

}

# Create the network plot
g <- visNetwork::visNetwork(
nodes = df_nodes,
edges = df_edges,
main = "Function Network",
submain = list(text = 'Functions without a test are <a style="color:#9c0000;">red</a> and those with a test are <a style="color:#65a765;">green</a>. Hover over nodes for more information.',
               style = "font-family:Calibri; font-size:15px; text-align:center;"),
footer = '<a href="https://github.com/dark-peak-analytics/assertHE/">Created with assertHE</a>',
width = "100%"
) |>
visNetwork::visEdges(arrows = 'from') |>
visNetwork::visOptions(
  manipulation = TRUE,
  highlightNearest = list(
    enabled = TRUE,
    degree = nrow(df_nodes),
    algorithm = "hierarchical"
  ),
  collapse = list(enabled = TRUE),
  height = "500px",
  width = "100%",
  nodesIdSelection = TRUE
)

return(g)
}

Define a couple of utils functions.


#' Remove artefacts from file path
#'
#' @param file_location Character scalar specifying the path of a file.
#'
#' @return A character scalar
#' @export
#'
#' @examples
#' \dontrun{
#' cleaned_file_path <- clean_file_path(
#'  file_location = "tests/testthat/example_project/R/calculate_QALYs.R:L41"
#' )
#' cleaned_file_path <- clean_file_path(
#'  file_location = c(
#'    "tests/testthat/example_project/R/calculate_QALYs.R:L41",
#'    "tests/testthat/example_project/R/calculate_QALYs.R:L49"
#'  )
#' )
#' }
clean_file_path <- function(file_location) {

clean_file_path <- gsub(":.*", "", file_location)

full_file_path <- ifelse(
test = is.na(clean_file_path),
yes =  "",
no = paste0(here::here(), "/", clean_file_path)
)

return(full_file_path)
}

' Extract function line in file path

'

' @param file_location Character scalar specifying the path of a file.

'

' @return A numeric scalar

' @export

'

' @examples

' \dontrun{

' cleaned_function_line <- clean_function_line(

' file_location = "tests/testthat/example_project/R/calculate_QALYs.R:L41"

' )

' cleaned_function_line <- clean_function_line(

' file_location = c(

' "tests/testthat/example_project/R/calculate_QALYs.R:L41",

' "tests/testthat/example_project/R/calculate_QALYs.R:L49"

' )

' }

clean_function_line <- function(file_location) {

function_line <- gsub(".*:L", "", file_location)

function_line <- ifelse( test = is.na(function_line), yes = -1L, no = as.numeric(function_line) )

return(function_line) }


- Build and test the shiny app.

ui <- shiny::fluidPage( shiny::tags$head( shiny::tags$script(" function openInRStudio(file_location) { console.log('Executing JavaScript function openInRStudio'); console.log('File location: ' + file_location); // For debugging

 // Send message to Shiny server
 Shiny.setInputValue('openRStudio', file_location);

} ") ), shiny::fluidRow( shiny::column(12, visNetwork::visNetworkOutput("networkPlot") ) ) )

server <- function(input, output, session) { output$networkPlot <- visNetwork::renderVisNetwork({

Create your visNetwork plot here

visualise_project(
  project_path = "tests/testthat/example_project",
  foo_path = "R",
  test_path = "tests/testthat",
  run_coverage = TRUE
)

})

Observer to handle opening files in RStudio

shiny::observeEvent(input$openRStudio, {

Open the file in RStudio

file_location <- input$openRStudio
file_path <- assertHE::clean_file_path(
  file_location = file_location
)
function_line <- assertHE::clean_function_line(
  file_location = file_location
)

if (file.exists(file_path)) {
  rstudioapi::navigateToFile(
    file = file_path,
    line = function_line
  )
} else {
  shiny::showNotification(
    paste("File not found:", file_path),
    type = "error"
  )
}

}) }

shiny::shinyApp(ui, server)

Smit-tay commented 7 months ago

Was the secret to this the use of "preventDefault()" ?

RobertASmith commented 7 months ago

Very nice @W-Mohammed, this works locally for me too.

Could you wrap the app into a function and submit a pull request? The function would need to be able to take the same arguments as visualise_model.

While it's not ideal to be launching a shiny app, its also likely better than any other solution we can come up with.

Just finalizing the abstract and draft paper for submission to R-HTA.

W-Mohammed commented 7 months ago

Was the secret to this the use of "preventDefault()" ?

Yes, @Smit-tay!

Let's take the following chunk as an example.

   "<br>Foo Location: <a href=\"#\" onclick=\"openInRStudio('",
    foo_paths, "'); event.preventDefault();\">",
    df_node_info$foo_location, "</a>",

When a user clicks on a link (<a href="#">), the default behaviour of the browser is to navigate to the URL specified in the href attribute. In this case, the href attribute is set to "#", which would normally cause the browser to navigate to the top of the current page.

By calling event.preventDefault() in the onclick event handler, you are instructing the browser to prevent this default navigation behaviour from occurring. Instead, only the specified JavaScript function (openInRStudio('foo_paths') in this case) will be executed, and the browser will not perform the usual action associated with clicking a link (i.e., navigating to the URL in the href attribute).

W-Mohammed commented 7 months ago

A shiny app was built to facilitate interactive code reviewing. This new functionality was integrated into the visualise_project function, which now gives the options of an HTML output with limited interactivity or a shiny app with more flexibility.

Check PR #51, branch WM_shiny_app, if you want to test or review the app.

Example code:

# Visualize project dependencies in shiny
visualise_project(
    project_path = "tests/testthat/example_project",
    foo_path = "R",
    test_path = "tests/testthat",
    run_coverage = TRUE,
    show_in_shiny = TRUE
)

# Visualize project dependencies in HTML
visualise_project(
    project_path = "tests/testthat/example_project",
    foo_path = "R",
    test_path = "tests/testthat",
    run_coverage = TRUE,
    show_in_shiny = FALSE
)