From 730842f2e7162f87cb26a7493ac7fe42a16f2cb2 Mon Sep 17 00:00:00 2001 From: valentina buoro Date: Mon, 7 Oct 2024 02:26:31 +0100 Subject: [PATCH] perf:updated functions to pass R-CMD Check: no visible binding for global variable for underlisted functions(lineage.neighbors.plot, lineage_sunburst, make_accnums_unique,make_df_iprscan_domain --- NAMESPACE | 1 + R/cleanup.R | 8 ++++---- R/fa2domain.R | 14 +++++++------- R/ipr2viz.R | 5 +++-- R/plotting.R | 14 +++++++------- 5 files changed, 22 insertions(+), 20 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 16cf0813..2c5597c6 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -229,6 +229,7 @@ importFrom(readr,write_file) importFrom(readr,write_lines) importFrom(readr,write_tsv) importFrom(rentrez,entrez_fetch) +importFrom(rlang,.data) importFrom(rlang,as_string) importFrom(rlang,sym) importFrom(sendmailR,mime_part) diff --git a/R/cleanup.R b/R/cleanup.R index 3a708415..1d9a1395 100755 --- a/R/cleanup.R +++ b/R/cleanup.R @@ -88,12 +88,12 @@ make_accnums_unique <- function(accnums) { # for the index of occurence for each accession number df_accnums <- tibble::tibble("accnum" = accnums) df_accnums <- df_accnums |> - dplyr::group_by(accnum) |> + dplyr::group_by(.data$accnum) |> dplyr::mutate(suffix = dplyr::row_number()) |> dplyr::ungroup() |> - dplyr::mutate(accnum_adjusted = paste0(accnum, "_", suffix)) |> - dplyr::arrange(accnum_adjusted) - accnums_adjusted <- df_accnums |> dplyr::pull(accnum_adjusted) + dplyr::mutate(accnum_adjusted = paste0(.data$accnum, "_", .data$suffix)) |> + dplyr::arrange(.data$accnum_adjusted) + accnums_adjusted <- df_accnums |> dplyr::pull(.data$accnum_adjusted) return(accnums_adjusted) } diff --git a/R/fa2domain.R b/R/fa2domain.R index 672d0856..ab1369e7 100644 --- a/R/fa2domain.R +++ b/R/fa2domain.R @@ -138,10 +138,10 @@ make_df_iprscan_domains <- function( # filter for the accnum of interest (note: it's possible the accession # number is not in the table [i.e., it had no domains]) df_iprscan_accnum <- df_iprscan |> - dplyr::filter(Analysis %in% analysis) |> - dplyr::filter(AccNum == accnum) |> + dplyr::filter(.data$Analysis %in% analysis) |> + dplyr::filter(.data$AccNum == accnum) |> dplyr::select(dplyr::all_of(c("AccNum", "DB.ID", "StartLoc", "StopLoc"))) |> - dplyr::arrange(StartLoc) + dplyr::arrange(.data$StartLoc) # handle the case of no records after filtering by "Analysis"; return the tibble # with 0 rows quickly if (nrow(df_iprscan_accnum) < 1) { @@ -153,9 +153,9 @@ make_df_iprscan_domains <- function( dplyr::rowwise() |> dplyr::mutate( seq_domain = XVector::subseq( - fasta[[grep(pattern = AccNum, x = names(fasta), fixed = TRUE)]], - start = StartLoc, - end = StopLoc + fasta[[grep(pattern = .data$AccNum, x = names(fasta), fixed = TRUE)]], + start = .data$StartLoc, + end = .data$StopLoc ) |> as.character() ) @@ -166,7 +166,7 @@ make_df_iprscan_domains <- function( id_domain = stringr::str_glue("{AccNum}-{DB.ID}-{StartLoc}_{StopLoc}") ) |> dplyr::ungroup() |> - dplyr::relocate(id_domain, .before = 1) + dplyr::relocate(.data$id_domain, .before = 1) return(df_iprscan_domains) } diff --git a/R/ipr2viz.R b/R/ipr2viz.R index bf3650f7..b0db06f9 100644 --- a/R/ipr2viz.R +++ b/R/ipr2viz.R @@ -53,6 +53,7 @@ theme_genes2 <- function() { #' @importFrom shiny showNotification #' @importFrom stats na.omit #' @importFrom rlang sym +#' @importFrom rlang .data #' #' @return #' @export @@ -295,7 +296,7 @@ ipr2viz_web <- function(infile_ipr, ## @SAM, colnames, merges, everything neeeds to be done now based on the ## combined lookup table from "common_data" lookup_tbl_path <- "/data/research/jravilab/common_data/cln_lookup_tbl.tsv" - lookup_tbl <- read_tsv(lookup_tbl_path, col_names = T, col_types = lookup_table_cols) + lookup_tbl <- read_tsv(lookup_tbl_path, col_names = T, col_types = .data$lookup_table_cols) ## Read IPR file and subset by Accessions ipr_out <- read_tsv(infile_ipr, col_names = T) @@ -303,7 +304,7 @@ ipr2viz_web <- function(infile_ipr, ## Need to fix eventually based on 'real' gene orientation! ipr_out$Strand <- rep("forward", nrow(ipr_out)) - ipr_out <- ipr_out %>% arrange(AccNum, StartLoc, StopLoc) + ipr_out <- ipr_out %>% arrange(.data$AccNum, .data$StartLoc, .data$StopLoc) ipr_out_sub <- filter( ipr_out, grepl(pattern = analysis, x = Analysis) diff --git a/R/plotting.R b/R/plotting.R index 7abd06d4..ef803f10 100644 --- a/R/plotting.R +++ b/R/plotting.R @@ -521,8 +521,8 @@ lineage.neighbors.plot <- function(query_data = "prot", query = "pspa", gather(key = TopNeighbors.DA, value = count, 19:ncol(query_data)) %>% select("Lineage", "TopNeighbors.DA", "count") %>% # "DomArch.norep","GenContext.norep", group_by(TopNeighbors.DA, Lineage) %>% - summarise(lincount = sum(count), bin = as.numeric(as.logical(lincount))) %>% - arrange(desc(lincount)) %>% + summarise(lincount =sum(count), bin = as.numeric(as.logical(.data$lincount))) %>% + arrange(desc(.data$lincount)) %>% within(TopNeighbors.DA <- factor(TopNeighbors.DA, levels = rev(names(sort(table(TopNeighbors.DA), decreasing = TRUE @@ -538,9 +538,9 @@ lineage.neighbors.plot <- function(query_data = "prot", query = "pspa", geom_tile( data = subset( query.ggplot, - !is.na(lincount) + !is.na(.data$lincount) ), # bin - aes(fill = lincount), # bin + aes(fill = .data$lincount), # bin colour = "coral3", size = 0.3 ) + # , width=0.7, height=0.7), scale_fill_gradient(low = "white", high = "darkred") + @@ -1223,13 +1223,13 @@ lineage_sunburst <- function(prot, lineage_column = "Lineage", group_by_at(levels_vec) %>% summarise(size = n()) protLevels <- protLevels %>% arrange() - tree <- d3_nest(protLevels, value_cols = "size") + tree <- .data$d3_nest(protLevels, value_cols = "size") # Plot sunburst if (type == "sunburst") { - result <- sunburst(tree, legend = list(w = 225, h = 15, r = 5, s = 5), colors = cpcols, legendOrder = legendOrder, width = "100%", height = "100%") + result <- sunburst(tree, legend = list(w = 225, h = 15, r = 5, s = 5), colors = .data$cpcols, legendOrder = legendOrder, width = "100%", height = "100%") } else if (type == "sund2b") { - result <- sund2b(tree) + result <- .data$sund2b(tree) } if (showLegend) {